Welcome

Summary

About this Document

This document is an interactive dashboard viewable from most modern internet browsers. The dashboard is a validation and diagnostics tool for CT-RAMP based Activity Based Models. Users can compare model performance against a household survey as part of a validation exercise or compare two model runs for sensitivity testing. All of the data, charts, and maps viewable in this dashboard are embedded directly into the HTML file. An internet connection is necessary for the best user experience, but is not required.

Users may navigate to different areas of the dashboard using the navigation bar at the top of the page, and may interact directly with most tables, charts, and maps.

This document is best viewed using the most recent versions of the following web browsers:

Note: Mozilla Firefox does not correctly render the images in this HTML file.

Summary

Modeling Region

Overview

Base Highlights

OHAS

Base Population

258,432

Base Households

108,752

Base Tours

295,245

Base Trips

835,017

Base Stops

261,069

Base VMT

2,804,609

Build Highlights

SOABM

Build Population

264,723

Build Households

110,691

Build Tours

325,289

Build Trips

821,453

Build Stops

170,875

Build VMT

2,690,803

Chart Column 1

Person Type Distribution

Household Size Distribution

Base Highlights2

OHAS

Tours per Person

Trips per Person

Stops per Person

Trips per Household

Build Highlights2

SOABM

Tours per Person

Trips per Person

Stops per Person

Trips per Household

Long Term Models

Chart Column 1

Auto Ownership

Census source:  ACS 2010, one year sample (PUMA 800,900)

Working from home:  ACS 2010 - 3 Year Sample  vs.  SOABM

Percentage Working From Home

Chart Column 2

Mandatory TLFD

Flows & Trip Lengths

Chart Column 1

District - District Flow of Workers
OHAS
X CENTRAL GrantsPass NORTHEAST NORTHWEST OtherJackson OtherJosephine SOUTH Total
CENTRAL 928 187 2,359 1,103 39 0 1,654 6,269
GrantsPass 0 6,075 211 663 0 1,356 0 8,305
NORTHEAST 942 86 8,650 5,787 449 31 711 16,656
NORTHWEST 690 0 5,737 6,889 252 89 732 14,390
OtherJackson 146 572 1,803 957 1,099 71 211 4,859
OtherJosephine 20 3,106 282 260 52 1,305 0 5,026
SOUTH 283 51 1,504 1,573 0 0 5,052 8,464
Total 3,008 10,078 20,546 17,233 1,891 2,852 8,361 63,969

Average Mandatory Trip Lengths
OHAS
Home District Work University School
CENTRAL 8.50 8.57 4.09
GrantsPass 5.97 17.85 2.15
NORTHEAST 6.18 5.50 2.31
NORTHWEST 4.85 5.50 2.37
OtherJackson 14.75 13.12 6.67
OtherJosephine 11.02 8.46 5.12
SOUTH 7.46 2.72 2.74
Total 7.28 6.68 3.02

Chart Column 2

District-District Flow of Workers
SOABM
X CENTRAL GrantsPass NORTHEAST NORTHWEST OtherJackson OtherJosephine SOUTH Total
CENTRAL 1,611 91 2,676 3,187 35 19 823 8,442
GrantsPass 67 11,678 492 429 181 782 49 13,678
NORTHEAST 1,463 292 14,082 8,419 261 32 425 24,974
NORTHWEST 1,237 284 8,627 11,197 149 57 415 21,966
OtherJackson 319 1,847 3,304 2,267 1,473 196 133 9,539
OtherJosephine 57 6,493 360 331 129 1,453 52 8,875
SOUTH 845 97 1,221 1,308 33 13 5,413 8,930
Total 5,599 20,782 30,762 27,138 2,261 2,552 7,310 96,404

Average Mandatory Trip Lengths
SOABM
Home District Work University School
CENTRAL 6.91 6.80 2.66
GrantsPass 4.96 4.16 1.96
NORTHEAST 5.49 4.90 2.30
NORTHWEST 4.66 4.26 2.08
OtherJackson 15.12 16.04 6.98
OtherJosephine 10.36 9.77 7.39
SOUTH 7.11 2.55 1.97
Total 6.90 6.28 3.02

Employment vs Workers

Chart Column 2

Employment vs Workers by Employment Type

Employment vs Workers (Total)

Tour Summaries

Chart Column 1

Daily Activity Pattern

Percentage of Households with a Joint Tour

Mandatory Tour Frequency

Chart Column 1

Total Tour Rate for each Person Type

Persons by Individual Non-Mandatory Tours

School Escorting

Chart Column 1

Escortee

Tour Level : Half tour leg of a school tour

Distribution of outbound and inbound legs of school tours by escort type for each student.

Rideshare: The student is dropped off or picked up by a driver on their way to work or school or way back home.

PureEscort: The student is dropped off or picked up by a driver who is traveling specifically for purposes of escorting the child, though the driver may make other non-escort stops.

Chauffeur

Tour Level : Half tour leg of a school tour

Distribution of outbound and inbound legs of school tours by escort type for each chauffeur.

Person Level : FT/PT Workers

Counts of workers who performed at least one Rideshare or PureEscort drop off or pick up. Only eligible workers (who go to work with children who go to school) are counted in the None category.

Chart Column 1

Student school half-tours by escort type - Outbound

Chauffeured school half-tours by escort type - Outbound

Workers with School Drops Offs and Pickups - OHAS_Oregon
DropOff Ride.Share Pure.Escort No.Escort Total
Ride Share 25,339 7,279 46,377 78,995
Pure Escort 3,783 5,567 12,063 21,413
No Escort 21,706 13,331 331,641 366,678
Total 50,828 26,177 390,081 467,086

Chart Column 1

Student school half-tours by escort type - Inbound

Chauffeured school half-tours by escort type - Inbound

Workers with School Drops Offs and Pickups - SOABM
DropOff Ride.Share Pure.Escort No.Escort Total
Ride Share 1,556 670 3,258 5,484
Pure Escort 0 307 0 307
No Escort 2,064 607 20,767 23,438
Total 3,620 1,584 24,025 29,229

Joint Tours

Chart Column 1

Joint Tour Frequency

Joint Tour Composition

Chart Column 1

Joint Tours By Number of Household Members

Joint Tours by Household Size

Party Size Distribution by Joint Tour Composition

Destination

Chart Column 1

Non-Mandatory Tour Length Distribution

Average Non-Mandatory Tour Lengths (Miles)

Purpose OHAS SOABM
Escorting 4.01 4.00
Indi-Maintenance 5.08 5.09
Indi-Discretionary 5.17 5.73
Joint-Maintenance 5.98 5.04
Joint-Discretionary 6.63 5.74
At-Work 3.03 2.75
Total 5.46 5.11

TOD

Chart Column 1

Tour Departure-Arrival Profile

Tour Aggregate Departure-Arrival Profile

Tour Mode

Chart Column 1

Tour Mode Choice


Tour Mode Choice

Results of Tour Mode Choice Models, which selects a primary mode for each tour.

Distribution of tours by tour mode and the ratio of autos to drivers in the household.

Chart Column 2

Chart Column 3

Stop Frequency

Chart Column 1

Stop Frequency - Directional

Chart Column 1

Stop Frequency - Total

Stop Purpose by Tour Purpose

Location

Chart Column 1

Stop Location - Out of Direction Distance

Chart Column 1

Average Out of Direction Distance (Miles)

_______________________________________________________
Tour_Purpose OHAS SOABM
Work 2.72 1.77
University 2.86 1.92
School 4.23 3.99
Escorting 2.47 2.26
Indi-Maintenance 2.12 1.79
Indi-Discretionary 2.18 2.02
Joint-Maintenance 1.57 2.05
Joint-Discretionary 1.94 2.19
At-Work 1.61 1.55

TOD

Chart Column 1

Stop & Trip Departure

Aggregate Stop & Trip Departure

Trip Mode

Chart Column 1

Trip Mode Choice

The results of the Trip Mode Choice Model, which predicts the mode of each trip on the tour.

Distribution of trips by trip mode and tour mode, which constrains the availability of each trip mode and influences the utility of each available trip mode.

Trip Mode Choice

Chart Column 2

Count vs Volume: All Day

Chart Column 2

Count vs Volume by Facility Type

Gap Statistics

________________________________________________________________________________________________________________________________________________________________
  Number of Links  Percent of Links
GapRange   Interstate Ramp HOV_Toll Arterial Collector Total   Interstate Ramp HOV_Toll Arterial Collector Total
>=100%   0 5 0 7 33 45   0% 5.6% 0 1.1% 11.2% 4.2%
50%~100%   0 17 0 26 12 55   0% 19.1% 0 3.9% 4.1% 5.2%
30%~50%   2 4 0 28 11 45   10% 4.5% 0 4.2% 3.7% 4.2%
20%~30%   1 2 0 25 6 34   5% 2.2% 0 3.8% 2% 3.2%
10%~20%   1 7 0 35 8 51   5% 7.9% 0 5.3% 2.7% 4.8%
0%~10%   2 2 0 50 13 67   10% 2.2% 0 7.6% 4.4% 6.3%
-10%~0%   5 5 0 48 10 68   25% 5.6% 0 7.3% 3.4% 6.4%
-20%~-10%   6 6 0 69 18 99   30% 6.7% 0 10.5% 6.1% 9.3%
-30%~-20%   1 12 0 68 21 102   5% 13.5% 0 10.3% 7.1% 9.6%
-50%~-30%   2 15 0 151 41 209   10% 16.9% 0 22.9% 13.9% 19.7%
<-50%   0 14 0 152 121 287   0% 15.7% 0 23.1% 41.2% 27%
Total   20 89 0 659 294 1062   100% 100% 0 100% 100% 100%
-10%~10%   7 7 0 98 23 135   35% 7.9% 0 14.9% 7.8% 12.7%
-20%~20%   14 20 0 202 49 285   70% 22.5% 0 30.7% 16.7% 26.8%
-30%~30%   16 34 0 295 76 421   80% 38.2% 0 44.8% 25.9% 39.6%

Count vs Volume: AM

Chart Column 2

Count vs Volume by Facility Type

Gap Statistics

________________________________________________________________________________________________________________________________________________________________
  Number of Links  Percent of Links
GapRange   Interstate Ramp HOV_Toll Arterial Collector Total   Interstate Ramp HOV_Toll Arterial Collector Total
>=100%   3 28 0 232 100 363   15% 31.5% 0 35.2% 34.1% 34.2%
50%~100%   6 18 0 123 28 175   30% 20.2% 0 18.7% 9.6% 16.5%
30%~50%   3 10 0 59 24 96   15% 11.2% 0 9% 8.2% 9%
20%~30%   4 3 0 28 11 46   20% 3.4% 0 4.2% 3.8% 4.3%
10%~20%   2 2 0 27 5 36   10% 2.2% 0 4.1% 1.7% 3.4%
0%~10%   0 6 0 27 11 44   0% 6.7% 0 4.1% 3.8% 4.1%
-10%~0%   0 6 0 21 8 35   0% 6.7% 0 3.2% 2.7% 3.3%
-20%~-10%   1 5 0 23 13 42   5% 5.6% 0 3.5% 4.4% 4%
-30%~-20%   0 2 0 27 15 44   0% 2.2% 0 4.1% 5.1% 4.1%
-50%~-30%   1 2 0 55 20 78   5% 2.2% 0 8.3% 6.8% 7.4%
<-50%   0 7 0 37 58 102   0% 7.9% 0 5.6% 19.8% 9.6%
Total   20 89 0 659 293 1061   100% 100% 0 100% 100% 100%
-10%~10%   0 12 0 48 19 79   0% 13.5% 0 7.3% 6.5% 7.4%
-20%~20%   3 19 0 98 37 157   15% 21.3% 0 14.9% 12.6% 14.8%
-30%~30%   7 24 0 153 63 247   35% 27% 0 23.2% 21.5% 23.3%

Count vs Volume: MD

Chart Column 2

Count vs Volume by Facility Type

Gap Statistics

________________________________________________________________________________________________________________________________________________________________
  Number of Links  Percent of Links
GapRange   Interstate Ramp HOV_Toll Arterial Collector Total   Interstate Ramp HOV_Toll Arterial Collector Total
>=100%   0 8 0 4 32 44   0% 9% 0 0.6% 10.9% 4.1%
50%~100%   1 12 0 23 12 48   5% 13.5% 0 3.5% 4.1% 4.5%
30%~50%   2 5 0 30 7 44   10% 5.6% 0 4.6% 2.4% 4.1%
20%~30%   1 2 0 25 10 38   5% 2.2% 0 3.8% 3.4% 3.6%
10%~20%   0 3 0 28 7 38   0% 3.4% 0 4.2% 2.4% 3.6%
0%~10%   0 8 0 45 13 66   0% 9% 0 6.8% 4.4% 6.2%
-10%~0%   6 1 0 47 10 64   30% 1.1% 0 7.1% 3.4% 6%
-20%~-10%   6 5 0 62 17 90   30% 5.6% 0 9.4% 5.8% 8.5%
-30%~-20%   2 10 0 75 20 107   10% 11.2% 0 11.4% 6.8% 10.1%
-50%~-30%   2 19 0 162 44 227   10% 21.3% 0 24.6% 15% 21.4%
<-50%   0 16 0 158 122 296   0% 18% 0 24% 41.5% 27.9%
Total   20 89 0 659 294 1062   100% 100% 0 100% 100% 100%
-10%~10%   6 9 0 92 23 130   30% 10.1% 0 14% 7.8% 12.2%
-20%~20%   12 17 0 182 47 258   60% 19.1% 0 27.6% 16% 24.3%
-30%~30%   15 29 0 282 77 403   75% 32.6% 0 42.8% 26.2% 37.9%

Count vs Volume: PM

Chart Column 2

Count vs Volume by Facility Type

Gap Statistics

________________________________________________________________________________________________________________________________________________________________
  Number of Links  Percent of Links
GapRange   Interstate Ramp HOV_Toll Arterial Collector Total   Interstate Ramp HOV_Toll Arterial Collector Total
>=100%   0 5 0 4 25 34   0% 5.6% 0 0.6% 8.5% 3.2%
50%~100%   1 7 0 15 12 35   5% 7.9% 0 2.3% 4.1% 3.3%
30%~50%   0 9 0 24 10 43   0% 10.1% 0 3.6% 3.4% 4%
20%~30%   1 5 0 26 7 39   5% 5.6% 0 3.9% 2.4% 3.7%
10%~20%   2 3 0 24 9 38   10% 3.4% 0 3.6% 3.1% 3.6%
0%~10%   2 5 0 31 9 47   10% 5.6% 0 4.7% 3.1% 4.4%
-10%~0%   4 5 0 48 9 66   20% 5.6% 0 7.3% 3.1% 6.2%
-20%~-10%   1 5 0 57 17 80   5% 5.6% 0 8.6% 5.8% 7.5%
-30%~-20%   5 10 0 68 12 95   25% 11.2% 0 10.3% 4.1% 8.9%
-50%~-30%   4 16 0 168 43 231   20% 18% 0 25.5% 14.6% 21.8%
<-50%   0 19 0 194 141 354   0% 21.3% 0 29.4% 48% 33.3%
Total   20 89 0 659 294 1062   100% 100% 0 100% 100% 100%
-10%~10%   6 10 0 79 18 113   30% 11.2% 0 12% 6.1% 10.6%
-20%~20%   9 18 0 160 44 231   45% 20.2% 0 24.3% 15% 21.8%
-30%~30%   15 33 0 254 63 365   75% 37.1% 0 38.5% 21.4% 34.4%

VMT

Chart Column 1

Vehicle Miles Traveled
OHAS
TOD SOV HOV2 HOV3 Truck Total
EA 305,177 25,859 11,083 24,400 366,520
AM 361,870 44,160 17,973 28,391 452,394
MD 1,604,736 226,097 71,592 236,229 2,138,653
PM 455,702 70,046 27,849 52,483 606,081
EV 450,252 73,090 29,037 75,009 627,389
Total 3,177,738 439,253 157,534 416,512 4,191,036

Chart Column 1

Vehicle Miles Traveled
SOABM
TOD SOV HOV2 HOV3 Truck Total
EA 305,177 25,859 11,083 24,400 366,520
AM 361,870 44,160 17,973 28,391 452,394
MD 1,604,736 226,097 71,592 236,229 2,138,653
PM 455,702 70,046 27,849 52,483 606,081
EV 450,252 73,090 29,037 75,009 627,389
Total 3,177,738 439,253 157,534 416,512 4,191,036

CVM

Chart Column 1

CVM Trips
OHAS
TOD Car Multi-Unit Truck Single-Unit Truck Total
EV1 87 60 17 164
EA 190 124 154 468
AM 1,437 361 533 2,332
MD 21,210 2,176 2,883 26,269
PM 1,397 74 70 1,541
EV2 1,528 74 17 1,619
Daily 25,848 2,869 3,675 32,392

Chart Column 1

CVM Trips
SOABM
TOD Car Multi-Unit Truck Single-Unit Truck Total
EV1 87 60 17 164
EA 190 124 154 468
AM 1,437 361 533 2,332
MD 21,210 2,176 2,883 26,269
PM 1,397 74 70 1,541
EV2 1,528 74 17 1,619
Daily 25,848 2,869 3,675 32,392

External

Chart Column 1

External Trips
OHAS
TOD HBCOLL HBO HBR HBS HBSCH HBW NHBNW NHBW Truck Total
EV1 0 0 0 0 0 0 615 156 283 1,053
EA 0 92 18 11 1 394 990 307 648 2,461
AM 12 334 77 46 9 722 500 455 684 2,840
MD 157 3,609 1,151 1,350 28 3,465 5,053 2,385 4,749 21,947
PM 18 493 245 165 1 661 1,938 569 1,118 5,208
EV2 12 490 265 167 1 481 2,883 718 1,622 6,639
Daily 198 5,018 1,757 1,740 40 5,723 11,979 4,588 9,104 40,147

External Trips
SOABM
TOD HBCOLL HBO HBR HBS HBSCH HBW NHBNW NHBW Truck Total
EV1 0 0 0 0 0 0 615 156 283 1,053
EA 0 92 18 11 1 394 990 307 648 2,461
AM 12 334 77 46 9 722 500 455 684 2,840
MD 157 3,609 1,151 1,350 28 3,465 5,053 2,385 4,749 21,947
PM 18 493 245 165 1 661 1,938 569 1,118 5,208
EV2 12 490 265 167 1 481 2,883 718 1,622 6,639
Daily 198 5,018 1,757 1,740 40 5,723 11,979 4,588 9,104 40,147
---
title: "`r paste(BASE_SCENARIO_NAME, 'vs.', BUILD_SCENARIO_NAME, 'Calibration Summary')`"
output: 
  flexdashboard::flex_dashboard:
    orientation: columns
    vertical_layout: fill
    theme: spacelab
    social: menu
    source_code: embed
---

```{r Setup}
opts_knit$set(root.dir = SYSTEM_APP_PATH)
```

```{r setpar}
knitr::opts_knit$set(global.par = TRUE)
```

```{r ggplot_Theme}
theme_db <- theme_bw() + theme(plot.margin = unit(c(10,10,20,10),"pt")) 
```

```{r Helper_Functions}
compare_bar_plotter <- function(base, build, base_name, build_name, xvar, yvar, 
                        xlabel = xvar, ylabel = yvar, position = "dodge", 
                        xrotate = FALSE, yrotate = FALSE, coord_flip = FALSE, 
                        title = "", left_offset = 0, bottom_offset = 0){
  
  base$grp <- base_name
  build$grp <- build_name
  colnames(build) <- colnames(base)
  
  df <- rbind(base, build)
  
  p <- ggplot(df, aes_string(x = xvar, y = yvar)) + 
    geom_bar(stat = "identity", aes(fill = grp), position = position) + 
    xlab(xlabel) + ylab(ylabel) +
    labs(fill = "") + 
    ggtitle(title) + 
    theme(axis.text.x=element_text(angle=50, size=1, vjust=0.5)) + 
    theme(axis.text.y=element_text(angle=50, size=1, vjust=0.5)) + 
    theme_bw()
  
  if (xrotate) {
    p <- p + theme(axis.text.x = element_text(angle = 45, hjust = 1))
  }
  if (yrotate) {
    p <- p + theme(axis.text.y = element_text(angle = 45, hjust = 1))
  }
  if (coord_flip) {
    p <- p + coord_flip()
  }
  
 
  p <- plotly_build(p)
  p$layout$margin$l <- p$layout$margin$l+left_offset
  p$layout$margin$b <- p$layout$margin$b+bottom_offset
  return(p)
  
}

# This function combines two dataframes and returns a data frame with standard field names
# The field names in the two dataframes should be same and should be same as the variable
# names passed to the function
# input parameter - dataframe1, dataframe2, x variable, list of y variables
# renames x and y variables in standard form - xvar, (yvar1, yvar2),...
# Y variables are named in pairs - (yvar1, yvar2), (yvar3, yvar4), ....
# yvar1, yvar3, .. correspond to first dataframe and yvar2, yvar4, .. correspond to second dataframe
# computes proportions for each  y variable variable
get_standardDF <- function(data_df1, data_df2, x, y, grp = "", shared = F){
  
  #data_df1=base_df
  #data_df2=build_df
  #x="id"
  #y = c("freq_out", "freq_inb")
  #grp = "purpose"
  #shared = T
  #
  # create ID variable to join base and build data
  if(!shared){
    ev1 <- paste("data_df1$id_var <- data_df1$", x, sep = "")
    ev2 <- paste("data_df2$id_var <- data_df2$", x, sep = "")
    eval(parse(text = ev1))
    eval(parse(text = ev2))
  }else{
    if(grp==""){
      stop("group variable not specified")
    }else{
      ev1 <- paste("data_df1$id_var <- paste(data_df1$", grp, ", data_df1$", x, ', sep = "")', sep = "")
      ev2 <- paste("data_df2$id_var <- paste(data_df2$", grp, ", data_df2$", x, ', sep = "")', sep = "")
      eval(parse(text = ev1))
      eval(parse(text = ev2))
    }
  }
  
  data_df <- data_df1
  
  # rename variables to standard names
  names(data_df)[names(data_df) == x] <- 'xvar'
  if(shared){
    if(grp==""){
      stop("group variable not specified")
    }else{
      names(data_df)[names(data_df) == grp] <- 'grp_var'
    }
  }
  
  for(i in seq(from=1, to=length(y))){
    start_pos <- i*2-1
    yvar1 <- paste('yvar', start_pos, sep = "")
    yvar2 <- paste('yvar', start_pos+1, sep = "")
    names(data_df)[names(data_df) == y[[i]]] <- paste('yvar', start_pos, sep = "")
    eval_expr <- paste("data_df$", yvar2, " <- data_df2$", y[[i]], "[match(data_df$id_var, data_df2$id_var)]", sep = "")
    eval(parse(text = eval_expr))
  }
  data_df[is.na(data_df)] <- 0
  
  #data_df$grp_var <- as.character(data_df$grp_var)
  
  # compute proportions for y variables
  for(i in seq(from=1, to=length(y))){
    start_pos <- i*2-1
    prop_var1 <- paste('prop', start_pos, sep = "")
    y_var1    <- paste('yvar', start_pos, sep = "")
    prop_var2 <- paste('prop', start_pos+1, sep = "")
    y_var2    <- paste('yvar', start_pos+1, sep = "")
    if(shared){
      if(grp==""){
        stop("group variable not specified")
      }else{
        eval_expr1 <- paste("data_df <- data_df %>% group_by(grp_var) %>% mutate(", prop_var1, " = prop.table(", y_var1, "))", sep = "")
        eval_expr2 <- paste("data_df <- data_df %>% group_by(grp_var) %>% mutate(", prop_var2, " = prop.table(", y_var2, "))", sep = "")
      }
    }else{
      eval_expr1 <- paste("data_df <- data_df %>% mutate(", prop_var1, " = prop.table(", y_var1, "))", sep = "")
      eval_expr2 <- paste("data_df <- data_df %>% mutate(", prop_var2, " = prop.table(", y_var2, "))", sep = "")
    }
    
    eval(parse(text = eval_expr1))
    eval(parse(text = eval_expr2))
  }
  
  # set all NAs to zero
  data_df[is.na(data_df)] <- 0
  
  if(!shared){
    return(data_df)
  }else{
    data_sd <- SharedData$new(data_df, ~grp_var)
    return(data_sd)
  }
}

# This function returns a SharedData object for creating comparison density plots
# input parameter - dataframe1, dataframe2, x variable, list of y variables, 
# grouping variable, names of each run
# The function expects same field names across both dataframes
# renames x and y variables in standard form - xvar, yvar1, yvar2,...
# computes proportions for each  y variable variable for each group and run
# combines two dataframe and adds a run identifier
get_sharedData <- function(data_df1, data_df2, run1_name = 'base', run2_name = 'build', 
                           x, y, grp){
  
  # rename variables to standard names
  names(data_df1)[names(data_df1) == x] <- 'xvar'
  names(data_df1)[names(data_df1) == grp] <- 'grp_var'
  for(i in 1:length(y)){
    names(data_df1)[names(data_df1) == y[[i]]] <- paste('yvar', i, sep = "")
  }
  
  names(data_df2)[names(data_df2) == x] <- 'xvar'
  names(data_df2)[names(data_df2) == grp] <- 'grp_var'
  for(i in 1:length(y)){
    names(data_df2)[names(data_df2) == y[[i]]] <- paste('yvar', i, sep = "")
  }
  
  # compute proportions for y variables
  data_df1 <- group_by(data_df1, grp_var)
  for(i in 1:length(y)){
    prop_var <- paste('prop', i, sep = "")
    y_var    <- paste('yvar', i, sep = "")
    eval_expr <- paste("data_df1 <- data_df1 %>% mutate(", prop_var, " = prop.table(", y_var, "))", sep = "")
    eval(parse(text = eval_expr))
  }
  
  data_df2 <- group_by(data_df2, grp_var)
  for(i in 1:length(y)){
    prop_var <- paste('prop', i, sep = "")
    y_var    <- paste('yvar', i, sep = "")
    eval_expr <- paste("data_df2 <- data_df2 %>% mutate(", prop_var, " = prop.table(", y_var, "))", sep = "")
    eval(parse(text = eval_expr))
  }
  
  # add run identifiers
  data_df1$run <- run1_name
  data_df2$run <- run2_name
  
  # combine dataframes
  data_df <- rbind(data_df1, data_df2)
  
  # set all NAs to zero
  data_df[is.na(data_df)] <- 0
  
  data_sd <- SharedData$new(data_df, ~grp_var)
  return(data_sd)
}

# This function returns bar plot for a given X-Y data frame
# The function expects the data frame columns to be named as
# xvar, yvar1, yvar2...
# function plots only two series at a time
# which two y series to plot is determined by the index variable
# index==1 :- yvar1, yvar2, index==2 :- yvar,3,4 and so on
# names of series to be plotted should also be passed as a list argument
# number of elements in names list determines the number of series to be added 
plotly_bar_plotter <- function(data, type = 'bar', xlabel = "", ylabel = "", percent = FALSE,
                               title = "", height = 0, width = 0, ynames = c(""), left_offset = 0, 
                               bottom_offset = 0, tickformat = "", hoverformat = "", tickangle = 0, index = 1, tickvals = c(), ticktext = c()){
  #initial setup
  start_pos <- 2*index - 1
  exp_tickvals <- ifelse(length(tickvals)>0, ', tickvals = tickvals', "")
  exp_ticktext <- ifelse(length(ticktext)>0, ', ticktext = ticktext', "")
  
  #generate plot
  if(!percent){
    ylab <- ifelse(ylabel=="", "Percent", ylabel)
    hformat <- ifelse(hoverformat=="", '.1f', hoverformat)
    eval_expr <- paste("p <- plot_ly(data, x = ~xvar, y = ~yvar", start_pos, ", type = type, name = ynames[[1]]) %>% ", 
                       "add_trace(y = ~yvar", start_pos+1, ", name = ynames[[2]]) %>% ", 
                       "layout(yaxis = list(hoverformat = hformat, title = ylab, tickformat = tickformat), xaxis = list(title = xlabel, tickangle = tickangle", exp_tickvals, exp_ticktext, "), barmode = 'group')", sep = "")
    eval(parse(text = eval_expr))
  }else{
    ylab <- ifelse(ylabel=="", "Frequency", ylabel)
    hformat <- ifelse(hoverformat=="", '.1%', hoverformat)
    eval_expr <- paste("p <- plot_ly(data, x = ~xvar, y = ~prop", start_pos, ", type = type, name = ynames[[1]]) %>% ", 
                       "add_trace(y = ~prop", start_pos+1, ", name = ynames[[2]]) %>% ", 
                       "layout(yaxis = list(hoverformat = hformat, title = ylab, tickformat = '%'), xaxis = list(title = xlabel, tickangle = tickangle", exp_tickvals, exp_ticktext,"), barmode = 'group')", sep = "")
    eval(parse(text = eval_expr))
  }
  
  p$x$layout$height <- height
  p$x$layout$width <- width
  p$x$layout$margin$b <- p$x$layout$margin$b + bottom_offset
  p$x$layout$margin$l <- p$x$layout$margin$l + left_offset
  return(p)
}

# This function returns a spline plot with fill for a gievn X-Y dataframe
# The function expects the data frame columns to be named as
# x = ~xvar, y = (~yvar1 or prop1),  (~yvar2 or prop2) adn so on (Frequency or Percent), 
# which y to use is determined by index parameter (one, two or three)
# and variable differentiating runs as ~run
# The function currebtly plots only one Y variables for each run
plotly_density_plotter <- function(data_df, index = "one", colors=c("orange", "steelblue"), fill = 'tozeroy', 
                                   title = "", xlabel = "", ylabel = "", percent = T, alpha = 0.7, tickvals, ticktext, tickangle = 0,
                                   height=400, left_offset = 0, bottom_offset = 0, shape = 'spline', legend = T){
  ##standardize data frame
  #names(data_df)[names(data_df)==xvar]     <- 'xvar'
  #names(data_df)[names(data_df)==yvar]     <- 'yvar1'
  #names(data_df)[names(data_df)==prop_var] <- 'prop1'
  #names(data_df)[names(data_df)==grp]      <- 'run'
  
  # prepare plot using standardized dataframe
  if(percent){
    ylab <- ifelse(ylabel=="", "Percent", ylabel)
    
    p <- switch(index, 
                "one" = plot_ly(data=data_df,x = ~xvar, y = ~prop1, colors=c("steelblue", "orange"), color = ~run, fill=fill) %>%
                  add_lines(name="",alpha=alpha, line = list(shape = shape)) %>%
                  layout(title = "",xaxis = list(title=xlabel, tickvals = tickvals, ticktext = ticktext, tickangle = tickangle), yaxis = list(title=ylab, tickformat = "%"), showlegend = legend),
                "two" = plot_ly(data=data_df,x = ~xvar, y = ~prop2, colors=c("steelblue", "orange"), color = ~run, fill=fill) %>%
                  add_lines(name="",alpha=alpha, line = list(shape = shape)) %>%
                  layout(title = "",xaxis = list(title=xlabel, tickvals = tickvals, ticktext = ticktext, tickangle = tickangle), yaxis = list(title=ylab, tickformat = "%"), showlegend = legend),
                "three" = plot_ly(data=data_df,x = ~xvar, y = ~prop3, colors=c("steelblue", "orange"), color = ~run, fill=fill) %>%
                  add_lines(name="",alpha=alpha, line = list(shape = shape)) %>%
                  layout(title = "",xaxis = list(title=xlabel, tickvals = tickvals, ticktext = ticktext, tickangle = tickangle), yaxis = list(title=ylab, tickformat = "%"), showlegend = legend)
                )
    
  }else{
    ylab <- ifelse(ylabel=="", "Frequency", ylabel)
    
    p <- switch(index,
                "one" = plot_ly(data=data_df,x = ~xvar, y = ~yvar1, colors=c("steelblue", "orange"), color = ~run, fill=fill) %>%
                  add_lines(name="",alpha=alpha, line = list(shape = shape)) %>%
                  layout(title = "",xaxis = list(title=xlabel, tickvals = tickvals, ticktext = ticktext, tickangle = tickangle), yaxis = list(title=ylab), showlegend = legend),
                "two" = plot_ly(data=data_df,x = ~xvar, y = ~yvar2, colors=c("steelblue", "orange"), color = ~run, fill=fill) %>%
                  add_lines(name="",alpha=alpha, line = list(shape = shape)) %>%
                  layout(title = "",xaxis = list(title=xlabel, tickvals = tickvals, ticktext = ticktext, tickangle = tickangle), yaxis = list(title=ylab), showlegend = legend),
                "three" = plot_ly(data=data_df,x = ~xvar, y = ~yvar3, colors=c("steelblue", "orange"), color = ~run, fill=fill) %>%
                  add_lines(name="",alpha=alpha, line = list(shape = shape)) %>%
                  layout(title = "",xaxis = list(title=xlabel, tickvals = tickvals, ticktext = ticktext, tickangle = tickangle), yaxis = list(title=ylab), showlegend = legend)
                )
    
    #p <- plot_ly(data=data_df,x = ~xvar, y = ~yvar1, colors=c("steelblue", "orange"), color = ~run, height=400, fill=fill) %>%
    #add_lines(name="",alpha=alpha, line = list(shape = shape)) %>% 
    #layout(title = "",xaxis = list(title=xlabel), yaxis = list(title=ylab))
  }
  
  p$x$layout$height <- height
  p$x$layout$margin$b <- p$x$layout$margin$b + bottom_offset
  p$x$layout$margin$l <- p$x$layout$margin$l + left_offset
  return(p)
}

# This function returns a pie chart
# Input is a 2 column data frame with a label variable and a value variable
plotly_pie_chart <- function(data, label_var, value_var, title = "", 
                               height = 0, width = 0, left_offset = 0,bottom_offset = 0, top_offset = 0, shared = F){
  
  colors <- c('rgb(211,94,96)', 'rgb(128,133,133)', 'rgb(144,103,167)', 'rgb(171,104,87)', 'rgb(114,147,203)')
  
  if(!shared){
    names(data)[names(data)==label_var] <- 'label_var'
    names(data)[names(data)==value_var] <- 'value_var'
    
    p <- plot_ly(data, labels = ~label_var, values = ~value_var, type = 'pie',
          textposition = 'outside',
          textinfo = 'label+percent',
          insidetextfont = list(color = '#FFFFFF'),
          marker = list(colors = colors,
                        line = list(color = '#FFFFFF', width = 2)),
          showlegend = FALSE, 
          sort = FALSE) %>%
    layout(title = title,
           xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
           yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
  }else{
    eval_expr <- paste("p <- plot_ly(data, labels = ~", label_var, ", values = ~", value_var, ", type = 'pie',
          textposition = 'outside',
          textinfo = 'label+percent',
          insidetextfont = list(color = '#FFFFFF'),
          marker = list(colors = colors,
                        line = list(color = '#FFFFFF', width = 2)),
          showlegend = FALSE, 
          sort = FALSE) %>%
    layout(title = title,
           xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
           yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))", sep = "")
    
    eval(parse(text = eval_expr))
  }
  
  
  p$x$layout$height <- height
  p$x$layout$width <- width
  p$x$layout$margin$b <- p$x$layout$margin$b + bottom_offset
  p$x$layout$margin$l <- p$x$layout$margin$l + left_offset
  p$x$layout$margin$t <- p$x$layout$margin$t + top_offset
  return(p)
}

lm_eqn <- function(df){
    m <- lm(y ~ x - 1, df);
    eq <- paste("Y = ", format(coef(m)[1], digits = 2), " * X , ", " r2 = ", format(summary(m)$r.squared, digits = 3), sep = "")
    return(eq)
}

```

Welcome
============================================

Summary {data-width=150}
--------------------------------------------

### About this Document

This document is an interactive dashboard viewable from most modern internet browsers. The dashboard is a validation and diagnostics tool for CT-RAMP based Activity Based Models. Users can compare model performance against a household survey as part of a validation exercise or compare two model runs for sensitivity testing. All of the data, charts, and maps viewable in this dashboard are embedded directly into the HTML file. An internet connection is necessary for the best user experience, but is not required.

Users may navigate to different areas of the dashboard using the navigation bar at the top of the page, and may interact directly with most tables, charts, and maps.

This document is best viewed using the most recent versions of the following web browsers:

* [Google Chrome](https://www.google.com/chrome/browser/desktop/)
* [Microsoft Internet Explorer](https://www.microsoft.com/en-us/download/internet-explorer.aspx)

Note: Mozilla Firefox does not correctly render the images in this HTML file.

Summary {data-width=600}
--------------------------------------------

### Modeling Region
```{r model_region}
bins <- c(0, 10, 20, 50, 100, 200, 500, 1000, Inf)
pal <- colorBin("YlOrRd", domain = zone_shp$HH, bins = bins)

m <- leaflet(data = zone_shp)%>% 
  addTiles() %>% 
  addProviderTiles(providers$OpenStreetMap, group = "Background Map") %>%
  addLayersControl(
    overlayGroups = "Background Map", options = layersControlOptions(collapsed = FALSE)
  ) %>%
  addPolygons(weight = 0.5, opacity = 1)
m

#  
```


Overview
============================================

Base Highlights {data-width=90}
--------------------------------------------

### 

```{r Run_Date1_ValueBox}
sample_rate <- ifelse(IS_BASE_SURVEY=="Yes", "-", paste(as.character(BASE_SAMPLE_RATE*100), "%"))
valueBox(BASE_SCENARIO_NAME, paste("Sample Rate: ", sample_rate, sep = ""), color = "DarkOrange")
base_pos <- which(base_csv_names=="totals")
base_df <- base_data[[base_pos]]
```

### Base Population
```{r Population1_ValueBox}
valueBox(prettyNum(round(base_df$value[base_df$name=="total_population"]/BASE_SAMPLE_RATE), big.mark = ","), "Population", icon = "ion-ios-people")
```

### Base Households
```{r Household1_ValueBox}
valueBox(prettyNum(round(base_df$value[base_df$name=="total_households"]/BASE_SAMPLE_RATE), big.mark = ","), "Households", icon = "glyphicon glyphicon-home")
```

### Base Tours
```{r Tours1_ValueBox}
valueBox(prettyNum(round(base_df$value[base_df$name=="total_tours"]/BASE_SAMPLE_RATE), big.mark = ","), "Total Tours", icon = "ion-refresh")
```

### Base Trips
```{r Trips1_ValueBox}
valueBox(prettyNum(round(base_df$value[base_df$name=="total_trips"]/BASE_SAMPLE_RATE), big.mark = ","), "Total Trips", icon = "ion-loop")
```

### Base Stops
```{r Stops1_ValueBox}
valueBox(prettyNum(round(base_df$value[base_df$name=="total_stops"]/BASE_SAMPLE_RATE), big.mark = ","), "Total Stops", icon = "ion-ios-location")
```

### Base VMT
```{r VMT1_ValueBox}
valueBox(prettyNum(round(base_df$value[base_df$name=="total_vmt"]/BASE_SAMPLE_RATE), big.mark = ","), "Total VMT", icon = "ion-android-car")
```



Build Highlights {data-width=90}
--------------------------------------------

### 

```{r Run_Date2_ValueBox}
valueBox(BUILD_SCENARIO_NAME, paste("Sample Rate: ", BUILD_SAMPLE_RATE*100, "%", sep = ""), color = "DarkOrange")
build_pos <- which(build_csv_names=="totals")
build_df <- build_data[[build_pos]]
```

### Build Population
```{r Population2_ValueBox}
valueBox(prettyNum(round(build_df$value[build_df$name=="total_population"]/BUILD_SAMPLE_RATE), big.mark = ","), "Population", icon = "ion-ios-people")
```

### Build Households
```{r Household2_ValueBox}
valueBox(prettyNum(round(build_df$value[build_df$name=="total_households"]/BUILD_SAMPLE_RATE), big.mark = ","), "Households", icon = "glyphicon glyphicon-home")
```

### Build Tours
```{r Tours2_ValueBox}
valueBox(prettyNum(round(build_df$value[build_df$name=="total_tours"]/BUILD_SAMPLE_RATE), big.mark = ","), "Total Tours", icon = "ion-refresh")
```

### Build Trips
```{r Trips2_ValueBox}
valueBox(prettyNum(round(build_df$value[build_df$name=="total_trips"]/BUILD_SAMPLE_RATE), big.mark = ","), "Total Trips", icon = "ion-loop")
```

### Build Stops
```{r Stops2_ValueBox}
valueBox(prettyNum(round(build_df$value[build_df$name=="total_stops"]/BUILD_SAMPLE_RATE), big.mark = ","), "Total Stops", icon = "ion-ios-location")
```

### Build VMT
```{r VMT2_ValueBox}
valueBox(prettyNum(round(build_df$value[build_df$name=="total_vmt"]/BUILD_SAMPLE_RATE), big.mark = ","), "Total VMT", icon = "ion-android-car")
```


Chart Column 1 {data-width=275}
--------------------------------------------
### Person Type Distribution
```{r Chart_Person_Type}
base_pos <- which(base_csv_names=="pertypeDistbn")
base_df <- base_data[[base_pos]]
base_df$PERNAME <- person_type_df$name_char[match(base_df$PERTYPE, person_type_df$code)]
base_df$PERNAME <- factor(base_df$PERNAME, levels = person_type_char)
build_pos <- which(build_csv_names=="pertypeDistbn")
build_df <- build_data[[build_pos]]
build_df$PERNAME <- person_type_df$name_char[match(build_df$PERTYPE, person_type_df$code)]
build_df$PERNAME <- factor(build_df$PERNAME, levels = person_type_char)

colnames(build_df) <- colnames(base_df)

std_DF <- get_standardDF(data_df1 = base_df, data_df2 = build_df, x = "PERNAME", y = c("freq"))
p <- plotly_bar_plotter(data = std_DF, xlabel = "Person Type", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T, bottom_offset = 60, tickangle = -30)
p

```

### Household Size Distribution
```{r Chart_HHSize}
base_pos <- which(base_csv_names=="hhSizeDist")
base_df <- base_data[[base_pos]]
build_pos <- which(build_csv_names=="hhSizeDist")
build_df <- build_data[[build_pos]]

colnames(build_df) <- colnames(base_df)

std_DF <- get_standardDF(data_df1 = base_df, data_df2 = build_df, x = "HHSIZE", y = c("freq"))
p <- plotly_bar_plotter(data = std_DF, xlabel = "HH Size", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T)
p

```

Base Highlights2 {data-width=90}
--------------------------------------------

### 

```{r Run_Date3_ValueBox}
valueBox(BASE_SCENARIO_NAME, "", color = "DarkOrange")
base_pos <- which(base_csv_names=="totals")
base_df <- base_data[[base_pos]]
```


### Tours per Person
```{r TourRate3_Gauge}
rate <- base_df$value[base_df$name=="total_tours"]/base_df$value[base_df$name=="total_population"]
gauge(prettyNum(round(rate, 2), big.mark = ","), min = 0, max = 2, gaugeSectors(danger = c(0,2), colors = c("Green", "Green", "Green")))
```

### Trips per Person
```{r TripRate3_Gauge}
rate <- base_df$value[base_df$name=="total_trips"]/base_df$value[base_df$name=="total_population"]
gauge(prettyNum(round(rate, 2), big.mark = ","), min = 0, max = 5, gaugeSectors(danger = c(0,5), colors = c("Green", "Green", "Green")))
```

### Stops per Person
```{r StopRate3_Gauge}
rate <- base_df$value[base_df$name=="total_stops"]/base_df$value[base_df$name=="total_population"]
gauge(prettyNum(round(rate, 2), big.mark = ","), min = 0, max = 2, gaugeSectors(danger = c(0,2), colors = c("Green", "Green", "Green")))
```

### Trips per Household
```{r TRate3_Gauge}
rate <- base_df$value[base_df$name=="total_trips"]/base_df$value[base_df$name=="total_households"]
gauge(prettyNum(round(rate, 2), big.mark = ","), min = 0, max = 10, gaugeSectors(danger = c(0,10), colors = c("Green", "Green", "Green")))
```


Build Highlights2 {data-width=90}
--------------------------------------------

### 

```{r Run_Date4_ValueBox}
valueBox(BUILD_SCENARIO_NAME, "", color = "DarkOrange")
build_pos <- which(build_csv_names=="totals")
build_df <- build_data[[build_pos]]
```


### Tours per Person
```{r TourRate4_Gauge}
rate <- build_df$value[build_df$name=="total_tours"]/build_df$value[build_df$name=="total_population"]
gauge(prettyNum(round(rate, 2), big.mark = ","), min = 0, max = 2, gaugeSectors(danger =  c(0,2), colors = c("Green", "Green", "Green")))
```

### Trips per Person
```{r TripRate4_Gauge}
rate <- build_df$value[build_df$name=="total_trips"]/build_df$value[build_df$name=="total_population"]
gauge(prettyNum(round(rate, 2), big.mark = ","), min = 0, max = 5, gaugeSectors(danger = c(0,5), colors = c("Green", "Green", "Green")))
```

### Stops per Person
```{r StopRate4_Gauge}
rate <- build_df$value[build_df$name=="total_stops"]/build_df$value[build_df$name=="total_population"]
gauge(prettyNum(round(rate, 2), big.mark = ","), min = 0, max = 2, gaugeSectors(danger = c(0,2), colors = c("Green", "Green", "Green")))
```

### Trips per Household
```{r TRate4_Gauge}
rate <- build_df$value[build_df$name=="total_trips"]/build_df$value[build_df$name=="total_households"]
gauge(prettyNum(round(rate, 2), big.mark = ","), min = 0, max = 10, gaugeSectors(danger = c(0,10), colors = c("Green", "Green", "Green")))
```


Long Term Models{data-navmenu="Long Term"}
============================================

Description {.sidebar data-width=225}
--------------------------------------------


**Auto Ownership**

Results of household auto ownership model, which predicts number of vehicles per household.

**Work from Home**

Result of work from home choice model, which predicts whether workers have usual work place at home. These workers do not generate work tours, but can have non-mandatory tours.

**Mandatory TLFD**

Results of work and school location choice models.

Distribution of workers by distance between home and usual work place, and students by distance between home and school location.

Chart Column 1 {data-width=200}
--------------------------------------------
### Auto Ownership{data-height=200}
```{r Chart_Auto_Ownership}
cat("Census source: ", AO_CENSUS_LONG)
base_pos <- which(base_csv_names=="autoOwnership")
base_df <- base_data[[base_pos]]
build_pos <- which(build_csv_names=="autoOwnership")
build_df <- build_data[[build_pos]]

colnames(build_df) <- colnames(base_df)

std_DF <- get_standardDF(data_df1 = base_df, data_df2 = build_df, x = "HHVEH", y = c("freq"))

p <- plotly_bar_plotter(data = std_DF, xlabel = "Number of Vehicles", ylabel = "Percent", ynames = c(AO_CENSUS_SHORT, BUILD_SCENARIO_NAME), percent = T, height = 225)
p
```


### {data-height=140}
```{r Gauge_WFH1}
cat("Working from home: ", WFH_Source, " vs. ", BUILD_SCENARIO_NAME)

base_df <- base_data[[which(base_csv_names=="wfh_summary_region")]]
rate <- base_df$WFH/base_df$Workers
gauge1 <- gauge(round(rate*100, 1), min = 0, max = 100, symbol = '%', gaugeSectors(danger =  c(0,1), colors = c("Green", "Green", "Green")))

build_df <- build_data[[which(build_csv_names=="wfh_summary")]]
rate <- build_df$WFH[build_df$District=="Total"]/build_df$Workers[build_df$District=="Total"]
gauge2 <- gauge(round(rate*100, 1), min = 0, max = 100, symbol = '%', gaugeSectors(danger =  c(0,1), colors = c("Green", "Green", "Green")))

bscols(widths = c(6,6),
  gauge1,
  gauge2
)

```

### Percentage Working From Home{data-height=250}
```{r Chart_WFH}
base_df <- base_data[[which(base_csv_names=="wfh_summary")]]
base_df$share <- base_df$WFH/base_df$Workers

build_df <- build_data[[which(build_csv_names=="wfh_summary")]]
build_df$share <- build_df$WFH/build_df$Workers

std_DF <- cbind(base_df[,c("District", "share")], build_df[,c("share")])
colnames(std_DF) <- c("xvar", "prop1", "prop2")

p <- plotly_bar_plotter(data = std_DF, xlabel = "District", ylabel = "Percent WFH", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T, height = 275, tickangle = -320, bottom_offset = 25)
p

```



Chart Column 2 {data-width=325}
--------------------------------------------


### Mandatory TLFD{data-height=475}
```{r mandatoryTLFD}
base_df1 <- base_data[[which(base_csv_names=="workTLFD")]]
base_df1 <- melt(base_df1, id = c("distbin"))

base_df2 <- base_data[[which(base_csv_names=="univTLFD")]]
base_df2 <- melt(base_df2, id = c("distbin"))

base_df3 <- base_data[[which(base_csv_names=="schlTLFD")]]
base_df3 <- melt(base_df3, id = c("distbin"))

base_df <- cbind(base_df1, base_df2$value, base_df3$value)
colnames(base_df) <- c("distbin","variable","value1","value2","value3")

build_df1 <- build_data[[which(build_csv_names=="workTLFD")]]
build_df1 <- melt(build_df1, id = c("distbin"))

build_df2 <- build_data[[which(build_csv_names=="univTLFD")]]
build_df2 <- melt(build_df2, id = c("distbin"))

build_df3 <- build_data[[which(build_csv_names=="schlTLFD")]]
build_df3 <- melt(build_df3, id = c("distbin"))

build_df <- cbind(build_df1, build_df2$value, build_df3$value)
colnames(build_df) <- c("distbin","variable","value1","value2","value3")

sd.purpose <- get_sharedData(data_df1 = build_df, data_df2 = base_df, run1_name = BUILD_SCENARIO_NAME, 
                             run2_name = BASE_SCENARIO_NAME, x = "distbin", y = c("value1", "value2", "value3"), grp = "variable")

p1 <- plotly_density_plotter(sd.purpose, index = "one", xlabel = "Miles to Work", percent = T, tickvals = seq(1,40,5), ticktext = seq(0,40,5), height = 240)
p2 <- plotly_density_plotter(sd.purpose, index = "two", xlabel = "Miles to University", percent = T, tickvals = seq(1,40,5), ticktext = seq(0,40,5), height = 240)
p3 <- plotly_density_plotter(sd.purpose, index = "three", xlabel = "Miles to School", percent = T, tickvals = seq(1,40,5), ticktext = seq(0,40,5), height = 240)
	
bscols(widths=c(12),
  list(filter_select("Purpose_County", "Select District", sd.purpose, ~grp_var,multiple=F),
  p1,
  p2,
  p3)
  )

```


Flows & Trip Lengths{data-navmenu="Long Term"}
============================================

Description {.sidebar data-width=225}
--------------------------------------------

**District-District Flow of workers**

Crosstab of workers by home county and usual work place county.

Note: Districts can be Tract, County, District etc.



Chart Column 1
--------------------------------------------

###{data-height=300}
```{r Table1_CountyFlows}
cat("District - District Flow of Workers")

base_pos <- which(base_csv_names=="countyFlows")
base_df <- base_data[[base_pos]]
base_df[,!colnames(base_df) %in% c("X")] <- base_df[,!colnames(base_df) %in% c("X")]/BASE_SAMPLE_RATE
t1 <- kable(base_df, format = 'html', caption = DISTRICT_FLOW_CENSUS, digits = 0, row.names = F, align = 'r', format.args = list(big.mark = ',')) %>%
  kable_styling('striped', font_size = 10)
t1
```

### {data-height=280}
```{r Table1_MandTripLengths}
cat("Average Mandatory Trip Lengths")

base_df <- base_data[[which(base_csv_names=="mandTripLengths")]]
df <- base_df
colnames(df) <- c("Home District", "Work","University","School")

eval_expr <- paste("t1 <- kable(df, format = 'html', digits = 2, row.names = F, align = 'r', format.args = list(big.mark = ',')) %>%
  kable_styling('striped', font_size = 10, full_width=F, position='center') %>%
  add_header_above(c(' ' = 1, '", BASE_SCENARIO_NAME, "' = 3))", sep = "")
eval(parse(text = eval_expr))
t1
```


Chart Column 2 
--------------------------------------------
###{data-height=300} 
```{r Table2_CountyFlows}
cat("District-District Flow of Workers")

build_pos <- which(build_csv_names=="countyFlows")
build_df <- build_data[[build_pos]]
build_df[,!colnames(build_df) %in% c("X")] <- build_df[,!colnames(build_df) %in% c("X")]/BUILD_SAMPLE_RATE
t2 <- kable(build_df, format = 'html', caption = BUILD_SCENARIO_NAME, digits = 0, row.names = F, align = 'r', format.args = list(big.mark = ',')) %>%
  kable_styling('striped', font_size = 10)
t2
```

###{data-height=280}
```{r Table2_MandTripLengths}
cat("Average Mandatory Trip Lengths")

build_df <- build_data[[which(build_csv_names=="mandTripLengths")]]
df <- build_df
colnames(df) <- c("Home District", "Work","University","School")

eval_expr <- paste("t2 <- kable(df, format = 'html', digits = 2, row.names = F, align = 'r', format.args = list(big.mark = ',')) %>%
  kable_styling('striped', font_size = 10, full_width=F, position='center') %>%
  add_header_above(c(' ' = 1, '", BUILD_SCENARIO_NAME, "' = 3))", sep = "")
eval(parse(text = eval_expr))
t2
```

Employment vs Workers{data-navmenu="Long Term"}
============================================

Description {.sidebar data-width=175}
--------------------------------------------

********

**Employment vs Workers comparison at MAZ level**

Results of work location model.

Comparison of assigned workers to available employment at MAZ level.


Chart Column 2{.tabset}
--------------------------------------------

### Employment vs Workers by Employment Type{data-height=575}
```{r job_wrk1}
base_df <- base_data[[which(base_csv_names=="job_worker_Summary")]]
base_df <- base_df[base_df$occp!="Total",]
build_df <- build_data[[which(build_csv_names=="job_worker_Summary")]]
build_df <- build_df[build_df$occp!="Total",]

counts_df <- data.frame(base_df[,c("MAZ","occp", "value")], build_df$value)
counts_df$occp <- occp_type_df$name[match(counts_df$occp, occp_type_df$code)]
counts_df$occp <- factor(counts_df$occp, levels = occp_type_names)

colnames(counts_df) <- c("CountLocation", "OCCTYPE", "x", "y")

#remove rows where both x and y are zeros
counts_df <- counts_df[!(counts_df$x==0 & counts_df$y==0),]

eq <- counts_df %>% group_by(OCCTYPE) %>% do(V1 = lm_eqn(.))
y_pos <- c(500, 650, 800, 950, 1100, 1250)
eq$y_pos <- y_pos

p1 <- ggplot(counts_df, aes(x=x, y=y, color=OCCTYPE)) + 
  geom_point(shape=1) + 
  geom_smooth(method=lm, formula = y ~ x - 1, se=FALSE) + 
  geom_abline(intercept = 0, slope = 1, linetype = 2) + 
  geom_text(data = eq, aes(x = 100, y = y_pos,label=V1),  parse = TRUE) + 
  geom_text(x = 1250, y = 0,label = "- - - - : 45 Deg Line",  parse = TRUE, color = "black") + 
  labs(x="Employment", y="Workers")
p1 <- plotly_build(p1)
p1


```

### Employment vs Workers (Total){data-height=575}
```{r job_wrk2}
base_df <- base_data[[which(base_csv_names=="job_worker_Summary")]]
base_df <- base_df[base_df$occp=="Total",]
build_df <- build_data[[which(build_csv_names=="job_worker_Summary")]]
build_df <- build_df[build_df$occp=="Total",]

counts_df <- data.frame(base_df[,c("MAZ","occp", "value")], build_df$value)
counts_df$occp <- occp_type_df$name[match(counts_df$occp, occp_type_df$code)]
counts_df$occp <- factor(counts_df$occp, levels = occp_type_names)

colnames(counts_df) <- c("CountLocation", "OCCTYPE", "x", "y")

#remove rows where both x and y are zeros
counts_df <- counts_df[!(counts_df$x==0 & counts_df$y==0),]

p2 <- ggplot(counts_df, aes(x=x, y=y)) + 
  geom_point(shape=1, color = "#0072B2") + 
  geom_smooth(method=lm, formula = y ~ x - 1, se=FALSE, color = "#0072B2") + 
  geom_abline(intercept = 0, slope = 1, linetype = 2) + 
  geom_text(x = 500, y = 2000,label = lm_eqn(counts_df),  parse = TRUE, color = "#0072B2", size = 6) + 
  geom_text(x = 2000, y = 0,label = "- - - - : 45 Deg Line",  parse = TRUE, color = "black") + 
  labs(x="Employment", y="Workers")
p2 <- plotly_build(p2)
p2
```


Tour Summaries{data-navmenu="Tour Level"}
============================================

Description {.sidebar data-width=225}
--------------------------------------------

This page summarizes day-pattern and tour generation model results.

**Daily Activity Pattern**

Results of Coordinated Daily Activity Pattern (CDAP) model, summarized for each person.

_M_ : One or more mandatory tours

_N_ : No mandatory tours but one or more non-mandatory tours

_H_ : No tours (either home all day or out of area)

**Percentage of Households with Joint Tour**

Also the result of the CDAP model, summarized for each household.

**Mandatory Tour Frequency**

Result of the mandatory tour frequency model, summarized for each person with a daily activity pattern type _M_

**Tour rate by person type**

Summary of tours per person resulting from all tour generation models. Joint tours are counted for each participant.

**Individual non-mandatory tour frequency**

Results of individual non-mandatory tour frequency model, summarized for each person with a daily activity pattern type _M_ or _N_.

Chart Column 1 {data-width=160}
--------------------------------------------

### Daily Activity Pattern{data-height=500}
```{r Hist_DAP}
base_df <- base_data[[which(base_csv_names=="dapSummary_vis")]]
base_df$PERNAME <- person_type_df$name_char[match(base_df$PERTYPE, person_type_df$code)]
base_df$PERNAME <- factor(base_df$PERNAME, levels = person_type_char)
base_df$DAP <- factor(base_df$DAP, levels = dap_types)
build_df <- build_data[[which(build_csv_names=="dapSummary_vis")]]
build_df$PERNAME <- person_type_df$name_char[match(build_df$PERTYPE, person_type_df$code)]
build_df$PERNAME <- factor(build_df$PERNAME, levels = person_type_char)
build_df$DAP <- factor(build_df$DAP, levels = dap_types)

base_df$grp <- BASE_SCENARIO_NAME
build_df$grp <- BUILD_SCENARIO_NAME
colnames(build_df) <- colnames(base_df)

sd.pertype <- get_standardDF(data_df1=base_df, data_df2=build_df, x="DAP", y = c("freq"), grp = "PERNAME", shared = T)
p <- plotly_bar_plotter(data = sd.pertype, height = 250, xlabel = "DAP", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T)

bscols(widths=c(3,9),
  list(
    filter_select("pertype_dap", "Select Person Type", sd.pertype, ~grp_var,multiple=F)),
    p
  )

```

### Percentage of Households with a Joint Tour{data-height=300}
```{r Hist_Presence_Joint}
base_pos <- which(base_csv_names=="hhsizeJoint")
base_df <- base_data[[base_pos]]
base_df <- base_df %>%
  group_by(HHSIZE) %>%
  mutate(percent = prop.table(freq)) %>%
  filter(JOINT==1) %>%
  ungroup()
build_pos <- which(build_csv_names=="hhsizeJoint")
build_df <- build_data[[build_pos]]
build_df <- build_df %>%
  group_by(HHSIZE) %>%
  mutate(percent = prop.table(freq)) %>%
  filter(JOINT==1) %>%
  ungroup()

colnames(build_df) <- colnames(base_df)

std_DF <- get_standardDF(data_df1 = base_df, data_df2 = build_df, x = "HHSIZE", y = c("percent"))
p <- plotly_bar_plotter(data = std_DF, xlabel = "HH Size", ylabel = "Percent of Households", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = F, tickformat = "%")
p

```

### Mandatory Tour Frequency{data-height=500}
```{r Hist_MTF}
base_pos <- which(base_csv_names=="mtfSummary_vis")
base_df <- base_data[[base_pos]]
base_df$PERNAME <- person_type_df$name_char[match(base_df$PERTYPE, person_type_df$code)]
base_df$PERNAME <- factor(base_df$PERNAME, levels = person_type_char)
base_df$mtf_name <- mtf_df$name[match(base_df$MTF, mtf_df$code)]
base_df$mtf_name <- factor(base_df$mtf_name, levels = mtf_names)
build_pos <- which(build_csv_names=="mtfSummary_vis")
build_df <- build_data[[build_pos]]
build_df$PERNAME <- person_type_df$name_char[match(build_df$PERTYPE, person_type_df$code)]
build_df$PERNAME <- factor(build_df$PERNAME, levels = person_type_char)
build_df$mtf_name <- mtf_df$name[match(build_df$MTF, mtf_df$code)]
build_df$mtf_name <- factor(build_df$mtf_name, levels = mtf_names)
colnames(build_df) <- colnames(base_df)

sd.pertype <- get_standardDF(data_df1=base_df, data_df2=build_df, x="mtf_name", y = c("freq"), grp = "PERNAME", shared = T)
p <- plotly_bar_plotter(data = sd.pertype, height = 250, xlabel = "MTF Choice", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T, tickangle = -30, bottom_offset = 50)

bscols(widths=c(3,9),
  list(
    filter_select("pertype_mtf", "Select Person Type", sd.pertype, ~grp_var,multiple=F)),
    p
  )

```

Chart Column 1 {data-width=150}
--------------------------------------------
### Total Tour Rate for each Person Type
```{r Hist_totaltours}
base_df <- base_data[[which(base_csv_names=="total_tours_by_pertype_vis")]]
base_df$PERNAME <- person_type_df$name_char[match(base_df$PERTYPE, person_type_df$code)]
base_df$PERNAME <- factor(base_df$PERNAME, levels = person_type_char)
base_df1 <- base_data[[which(base_csv_names=="pertypeDistbn")]]
base_df$persons <- base_df1$freq[match(base_df$PERTYPE, base_df1$PERTYPE)]
base_df$tourrate <- round(base_df$freq/base_df$persons,2)

build_df <- build_data[[which(build_csv_names=="total_tours_by_pertype_vis")]]
build_df$PERNAME <- person_type_df$name_char[match(build_df$PERTYPE, person_type_df$code)]
build_df$PERNAME <- factor(build_df$PERNAME, levels = person_type_char)
build_df1 <- build_data[[which(build_csv_names=="pertypeDistbn")]]
build_df$persons <- build_df1$freq[match(build_df$PERTYPE, build_df1$PERTYPE)]
build_df$tourrate <- round(build_df$freq/build_df$persons,2)

colnames(build_df) <- colnames(base_df)

std_DF <- get_standardDF(data_df1 = base_df, data_df2 = build_df, x = "PERNAME", y = c("tourrate"))
p <- plotly_bar_plotter(data = std_DF, xlabel = "Person Type", ylabel = "Tour Rate", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = F, height = 340, tickangle = -30, bottom_offset = 50)
p


```


### Persons by Individual Non-Mandatory Tours
```{r Hist_INM}
base_df <- base_data[[which(base_csv_names=="inmSummary_vis")]]
base_df$PERNAME <- person_type_df$name_char[match(base_df$PERTYPE, person_type_df$code)]
base_df$PERNAME <- factor(base_df$PERNAME, levels = person_type_char)

build_df <- build_data[[which(build_csv_names=="inmSummary_vis")]]
build_df$PERNAME <- person_type_df$name_char[match(build_df$PERTYPE, person_type_df$code)]
build_df$PERNAME <- factor(build_df$PERNAME, levels = person_type_char)

colnames(build_df) <- colnames(base_df)

sd.pertype <- get_standardDF(data_df1=base_df, data_df2=build_df, x="nmtours", y = c("freq"), grp = "PERNAME", shared = T)
#p <- plotly_bar_plotter(data = sd.pertype, height = 340, xlabel = "Number of Tours", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, #BUILD_SCENARIO_NAME), percent = T, tickvals = c(seq(0,2), "3pl"), ticktext = c("0", "1", "2", "3pl"))

p <- plotly_bar_plotter(data = sd.pertype, height = 340, xlabel = "Number of Tours", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T)

bscols(widths=c(3,9),
  list(
    filter_select("pertype_mtf", "Select Person Type", sd.pertype, ~grp_var,multiple=F)),
    p
  )


```


School Escorting {data-navmenu="Tour Level"}
============================================


Chart Column 1 {data-width=380}
--------------------------------------------

### Escortee{data-height=400}
```{r schesc7}

base_df <- base_data[[which(base_csv_names=="esctype_by_childtype")]]
build_df <- build_data[[which(build_csv_names=="esctype_by_childtype")]]

base_df$grp <- BASE_SCENARIO_ALT
build_df$grp <- BUILD_SCENARIO_NAME
colnames(build_df) <- colnames(base_df)

sd.pertype <- get_standardDF(data_df1=base_df, data_df2=build_df, x="esc_type", y = c("freq_out", "freq_inb"), grp = "child_type", shared = T)

p1 <- plotly_pie_chart(data = sd.pertype, label_var = "xvar", value_var = "yvar1", height = 260, title = BASE_SCENARIO_ALT, shared = T, top_offset = 80)
p2 <- plotly_pie_chart(data = sd.pertype, label_var = "xvar", value_var = "yvar2", height = 260, title = BUILD_SCENARIO_NAME, shared = T, top_offset = 80)
p3 <- plotly_pie_chart(data = sd.pertype, label_var = "xvar", value_var = "yvar3", height = 260, title = BASE_SCENARIO_ALT, shared = T, top_offset = 80)
p4 <- plotly_pie_chart(data = sd.pertype, label_var = "xvar", value_var = "yvar4", height = 260, title = BUILD_SCENARIO_NAME, shared = T, top_offset = 80)

bscols(widths=c(12),
filter_select("Child_type", "Select Child Type", sd.pertype, ~grp_var,multiple=F)
)
```

_Tour Level_ : Half tour leg of a school tour

Distribution of outbound and inbound legs of school tours by escort type for each student.

_Rideshare_:  The student is dropped off or picked up by a driver on their way to work or school or way back home. 

_PureEscort_: The student is dropped off or picked up by a driver who is traveling specifically for purposes of escorting the child, though the driver may make other non-escort stops.


### Chauffeur{data-height=300}
```{r schesc8}

base_df <- base_data[[which(base_csv_names=="esctype_by_chauffeurtype")]]
build_df <- build_data[[which(build_csv_names=="esctype_by_chauffeurtype")]]

base_df$grp <- BASE_SCENARIO_ALT
build_df$grp <- BUILD_SCENARIO_NAME
colnames(build_df) <- colnames(base_df)

sd.pertype <- get_standardDF(data_df1=base_df, data_df2=build_df, x="esc_type", y = c("freq_out", "freq_inb"), grp = "chauffeur", shared = T)
p5 <- plotly_bar_plotter(data = sd.pertype, height = 200, xlabel = "School Escort Type", ylabel = "Percent", ynames = c(BASE_SCENARIO_ALT, BUILD_SCENARIO_NAME), percent = T)

p6 <- plotly_bar_plotter(data = sd.pertype, height = 200, xlabel = "School Escort Type", ylabel = "Percent", ynames = c(BASE_SCENARIO_ALT, BUILD_SCENARIO_NAME), percent = T, index = 2)

bscols(widths=c(12),
  
    filter_select("Chauffeur_type", "Select Chauffeur Type", sd.pertype, ~grp_var,multiple=F)
    
  )

```

_Tour Level_ : Half tour leg of a school tour

Distribution of outbound and inbound legs of school tours by escort type for each chauffeur.


### {data-height=300}

_Person Level_ : FT/PT Workers

Counts of workers who performed at least one _Rideshare_ or _PureEscort_ drop off or pick up. Only eligible workers (who go to work with children who go to school) are counted in the _None_ category.


Chart Column 1 {data-width=750}
--------------------------------------------

### Student school half-tours by escort type - Outbound{data-height=400}
```{r schesc1}


bscols(widths=c(6,6),
  p1, p2
  )

```

### Chauffeured school half-tours by escort type - Outbound{data-height=300}
```{r schesc2}

bscols(widths=c(12),
  
    p5
  )

```

### {data-height=300}
```{r schesc3}
base_df <- base_data[[which(base_csv_names=="worker_school_escorting")]]
nums <- vapply(base_df, is.numeric, FUN.VALUE = logical(1))
base_df[,nums] <- round(base_df[,nums])

#t1 <- datatable(base_df, options = list(pageLength = 4), height = 100, caption = "Workers with School Drops Offs and Pickups - #OHAS_Oregon")
#t1

t1 <- kable(base_df, caption = paste("Workers with School Drops Offs and Pickups -", BASE_SCENARIO_ALT), digits = 0, row.names = F, align = 'r', format.args = list(big.mark = ','))
t1
```


Chart Column 1 {data-width=750}
--------------------------------------------

### Student school half-tours by escort type - Inbound{data-height=400}
```{r schesc4}

bscols(widths=c(6,6),
  p3, p4
  )

```

### Chauffeured school half-tours by escort type - Inbound{data-height=300}
```{r schesc5}
p6

```



### {data-height=300}
```{r schesc6}
build_df <- build_data[[which(build_csv_names=="worker_school_escorting")]]
nums <- vapply(build_df, is.numeric, FUN.VALUE = logical(1))
build_df[,nums] <- round(build_df[,nums])

#t2 <- datatable(build_df, options = list(pageLength = 4), height = 100, caption = paste("Workers with School Drops Offs and Pickups - ", #BUILD_SCENARIO_NAME, sep = ""))
#t2

t2 <- kable(build_df, caption = paste("Workers with School Drops Offs and Pickups -", BUILD_SCENARIO_NAME), digits = 0, row.names = F, align = 'r', format.args = list(big.mark = ','))
t2

```


Joint Tours{data-navmenu="Tour Level"}
============================================

Description {.sidebar data-width=225}
--------------------------------------------

********

This page tabulates the results of the Joint Tour Frequency and Composition Model and the Joint Tour Person Participation Model.

**Joint Tour Frequency**

The frequency of households by number and purpose of joint tours.

**Joint Tour Composition**

The frequency of tours by composition (Adults only, Children only, Adults + Children).

**Joint Tour Party Size**

The frequency of joint tours by the number of household members participating in the tour.

**Joint Tours by HH Size**

The frequency of households by household size and the number of joint tours per household.

**Joint Tours by HH Size**

_Tour Level_

Distribution of joint tours by party size for each composition type.


Chart Column 1 {data-width=150}
--------------------------------------------
### Joint Tour Frequency{data-height=675}
```{r jtf}
base_df <- base_data[[which(base_csv_names=="jtf")]]
build_df <- build_data[[which(build_csv_names=="jtf")]]
# remove no joint tours option
base_df <- base_df[-1,]
build_df <- build_df[-1,]
colnames(build_df) <- colnames(base_df)

std_DF <- get_standardDF(data_df1 = base_df, data_df2 = build_df, x = "alt_name", y = c("freq"))
std_DF$xvar <- factor(std_DF$xvar, levels = jtf_alternatives)

p <- plotly_bar_plotter(data = std_DF, xlabel = "Joint Tour Combination", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T, height = 500, bottom_offset = 275, tickangle = 300)
p

```

### Joint Tour Composition
```{r jtf_comp}
base_df <- base_data[[which(base_csv_names=="jointComp")]]
names(base_df)[names(base_df)=="tour_composition"] <- "COMPOSITION"
build_df <- build_data[[which(build_csv_names=="jointComp")]]
colnames(build_df) <- colnames(base_df)

p1 <- plotly_pie_chart(data = base_df, label_var = "COMPOSITION", value_var = "freq", height = 250, title = BASE_SCENARIO_NAME, top_offset = 50)
p2 <- plotly_pie_chart(data = build_df, label_var = "COMPOSITION", value_var = "freq", height = 250, title = BUILD_SCENARIO_NAME, top_offset = 50)

bscols(widths=c(6,6),
  p1,
  p2
  )
```

Chart Column 1 {data-width=150}
--------------------------------------------

### Joint Tours By Number of Household Members
```{r jtf_partysize}
base_df <- base_data[[which(base_csv_names=="jointPartySize")]]
build_df <- build_data[[which(build_csv_names=="jointPartySize")]]
colnames(build_df) <- colnames(base_df)

build_df$freq[build_df$NUMBER_HH==5] <- sum(build_df$freq[build_df$NUMBER_HH>=5])
build_df <- build_df[build_df$NUMBER_HH<=5, ]

std_DF <- get_standardDF(data_df1 = base_df, data_df2 = build_df, x = "NUMBER_HH", y = c("freq"))
p <- plotly_bar_plotter(data = std_DF, xlabel = "Joint Party Size", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T, height = 200)
p

```

### Joint Tours by Household Size
```{r jtf_byhhsize}
base_pos <- which(base_csv_names=="jointToursHHSize")
base_df <- base_data[[base_pos]]

build_pos <- which(build_csv_names=="jointToursHHSize")
build_df <- build_data[[build_pos]]
colnames(build_df) <- colnames(base_df)

sd.pertype <- get_standardDF(data_df1=base_df, data_df2=build_df, x="jointTours", y = c("freq"), grp = "hhsize", shared = T)
p <- plotly_bar_plotter(data = sd.pertype, height = 225, xlabel = "Number of Joint Tours", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T)

bscols(widths=c(3,9),
  list(
    filter_select("jtf_hhsize", "Select HH Size Group", sd.pertype, ~grp_var,multiple=F)),
    p
  )

```

### Party Size Distribution by Joint Tour Composition
```{r jtf_comppartysize}
base_df <- base_data[[which(base_csv_names=="jointCompPartySize")]]
build_df <- build_data[[which(build_csv_names=="jointCompPartySize")]]
colnames(build_df) <- colnames(base_df)

sd.pertype <- get_standardDF(data_df1=base_df, data_df2=build_df, x="partysize", y = c("freq"), grp = "comp", shared = T)
p <- plotly_bar_plotter(data = sd.pertype, height = 225, xlabel = "Joint Party Size", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T)

bscols(widths=c(3,9),
  list(
    filter_select("jtf_comp", "Select Party Composition", sd.pertype, ~grp_var,multiple=F)),
    p
  )

```




Destination{data-navmenu="Tour Level"}
============================================

Description {.sidebar data-width=225}
--------------------------------------------

********

**Non-Mandatory Trip Length Distribution**

Results of non-mandatory tour destination choice models. 

Distribution of tours by distance between tour origin and destination for each non-mandatory tour purpose.


Chart Column 1 {data-width=100}
--------------------------------------------
### Non-Mandatory Tour Length Distribution{data-height=350}
```{r nm_tlfd}
base_df <- base_data[[which(base_csv_names=="tourDistProfile_vis")]]
build_df <- build_data[[which(build_csv_names=="tourDistProfile_vis")]]
colnames(build_df) <- colnames(base_df)

# change purpose names to standard format
base_df$PURPOSE <- as.character(base_df$PURPOSE)
build_df$PURPOSE <- as.character(build_df$PURPOSE)
base_df$PURPOSE <- purpose_type_df$name[match(base_df$PURPOSE, purpose_type_df$code)]
build_df$PURPOSE <- purpose_type_df$name[match(build_df$PURPOSE, purpose_type_df$code)]

sd.purpose <- get_sharedData(data_df1 = base_df, data_df2 = build_df, run1_name = BASE_SCENARIO_NAME, 
                             run2_name = BUILD_SCENARIO_NAME, x = "distbin", y = c("freq"), grp = "PURPOSE")

p1 <- plotly_density_plotter(sd.purpose, index = "one", xlabel = "Miles", percent = T, 
                             tickvals = seq(2,41), ticktext = c(seq(1,40), "40pl"))
bscols(widths=c(2,10),
  filter_select("Tour Purpose", "Select Tour Purpose", sd.purpose, ~grp_var,multiple=F),
  p1
  )
```

### Average Non-Mandatory Tour Lengths (Miles){data-height=250}
```{r Table1_nonMandTripLength}
base_df <- base_data[[which(base_csv_names=="nonMandTripLengths")]]
build_df <- build_data[[which(build_csv_names=="nonMandTripLengths")]]
df <- data.frame(base_df, build_df[,-1])
colnames(df) <- c("Purpose", BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME)
df$Purpose <- purpose_type_df$name[match(df$Purpose, purpose_type_df$code)]

t1 <- kable(df, format = "html", digits = 2, row.names = F, align = 'c', format.args = list(big.mark = ',')) %>%
  kable_styling("striped", full_width = F)
t1
```


TOD {data-navmenu="Tour Level"}
============================================

Description {.sidebar data-width=200}
--------------------------------------------

********

**Tour Departure Arrival & Duration**

Tour Time-of-day Choice Model results.

Each tour is assigned a time period of departure (time leaving home or work) and arrival (time arriving back at home or work). The entire day is divided into 40 half-hour bins (the first bin includes 3:00 AM to 5:00 AM and the last bin includes 12:00 PM to 3:00 AM).

Tour duration is calculated as a function of departure and arrival period. It includes travel time and time spent at the primary destination and all intermediate stops.

Results are shown for tours, filtered by tour purpose.

********

**Aggregate Tour Arrival-Departure**

_EA_: 3:00 AM to 7:30 AM

_AM_: 7:30 AM to 9:00 AM

_MD_: 9:00 AM to 5:00 PM

_PM_: 5:00 PM to 7:00 PM

_EV_: 7:00 PM to 3:00 AM

Chart Column 1 {.tabset}
--------------------------------------------
### Tour Departure-Arrival Profile
```{r tour_tod}
base_df <- base_data[[which(base_csv_names=="todProfile_vis")]]
base_df$tod_bin <- tod_df$bin[match(base_df$id, tod_df$id)]
base_df$dur_bin <- dur_df$bin[match(base_df$id, dur_df$id)]
build_df <- build_data[[which(build_csv_names=="todProfile_vis")]]
build_df$tod_bin <- tod_df$bin[match(build_df$id, tod_df$id)]
build_df$dur_bin <- dur_df$bin[match(build_df$id, dur_df$id)]
colnames(build_df) <- colnames(base_df)

# change purpose names to standard format
base_df$purpose <- as.character(base_df$purpose)
build_df$purpose <- as.character(build_df$purpose)
base_df$purpose <- purpose_type_df$name[match(base_df$purpose, purpose_type_df$code)]
build_df$purpose <- purpose_type_df$name[match(build_df$purpose, purpose_type_df$code)]

sd.purpose <- get_sharedData(data_df1 = base_df, data_df2 = build_df, run1_name = BASE_SCENARIO_NAME, 
                             run2_name = BUILD_SCENARIO_NAME, x = "id", y = c("freq_dep", "freq_arr", "freq_dur"), grp = "purpose")

p1 <- plotly_density_plotter(sd.purpose, index = "one", xlabel = "Tour Departure", percent = T, left_offset = 25, 
                             tickvals = seq(1,40), ticktext = todBins, bottom_offset = 150, tickangle = 315, height = 275)
p2 <- plotly_density_plotter(sd.purpose, index = "two", xlabel = "Tour Arrival", percent = T, left_offset = 25, 
                             tickvals = seq(1,40), ticktext = todBins, bottom_offset = 150, tickangle = 315, height = 275)
p3 <- plotly_density_plotter(sd.purpose, index = "three", xlabel = "Tour Duraction", percent = T, left_offset = 25, 
                             tickvals = seq(1,40), ticktext = durBins, bottom_offset = 50, tickangle = 315, height = 225)
	
bscols(widths=c(2,10),
  filter_select("Tour Purpose", "Select Tour Purpose", sd.purpose, ~grp_var,multiple=F),
  list(p1, p2, p3)
  )


```

### Tour Aggregate Departure-Arrival Profile
```{r tour_tod_agg}
base_df <- base_data[[which(base_csv_names=="todProfile_vis")]]
base_df$tod_agg <- cut(base_df$id, breaks = timePeriodBreaks, labels = timePeriods, right = FALSE)
base_df <- base_df %>%
  group_by(purpose, tod_agg) %>%
  summarise(freq_dep = sum(freq_dep), freq_arr = sum(freq_arr), freq_dur = sum(freq_dur)) %>%
  ungroup()

build_df <- build_data[[which(build_csv_names=="todProfile_vis")]]
build_df$tod_agg <- cut(build_df$id, breaks = timePeriodBreaks, labels = timePeriods, right = FALSE)
build_df <- build_df %>%
  group_by(purpose, tod_agg) %>%
  summarise(freq_dep = sum(freq_dep), freq_arr = sum(freq_arr), freq_dur = sum(freq_dur)) %>%
  ungroup()
colnames(build_df) <- colnames(base_df)

# change purpose names to standard format
base_df$purpose <- as.character(base_df$purpose)
build_df$purpose <- as.character(build_df$purpose)
base_df$purpose <- purpose_type_df$name[match(base_df$purpose, purpose_type_df$code)]
build_df$purpose <- purpose_type_df$name[match(build_df$purpose, purpose_type_df$code)]

sd.purpose <- get_standardDF(data_df1=base_df, data_df2=build_df, x="tod_agg", y = c("freq_dep", "freq_arr", "freq_dur"), grp = "purpose", shared = T)

p1 <- plotly_bar_plotter(data = sd.purpose, height = 350, xlabel = "Tour Departure", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T)
p2 <- plotly_bar_plotter(data = sd.purpose, height = 350, xlabel = "Tour Arrival", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T, index = 2)

bscols(widths=c(2,10),
  filter_select("Tour Purpose", "Select Tour Purpose", sd.purpose, ~grp_var,multiple=F),
  list(p1, p2)
  )


```



Tour Mode{data-navmenu="Tour Level"}
============================================


Chart Column 1{data-width=150}
--------------------------------------------


### Tour Mode Choice
```{r tourMode}
base_df <- base_data[[which(base_csv_names=="tmodeProfile_vis")]]
base_df$purpose <- as.character(base_df$purpose)
base_df$purpose <- purpose_type_df$name[match(base_df$purpose, purpose_type_df$code)]
build_df <- build_data[[which(build_csv_names=="tmodeProfile_vis")]]
build_df$purpose <- as.character(build_df$purpose)
build_df$purpose <- purpose_type_df$name[match(build_df$purpose, purpose_type_df$code)]
colnames(build_df) <- colnames(base_df)


sd.pertype <- get_standardDF(data_df1=base_df, data_df2=build_df, x="id", y = c("freq_as0", "freq_as1", "freq_as2", "freq_all"), grp = "purpose", shared = T)
p1 <- plotly_bar_plotter(data = sd.pertype, height = 375, xlabel = "Tour Mode [Zero Auto]", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T, tickvals = seq(1,9), ticktext = tourMode, bottom_offset = 55, tickangle = 300)
p2 <- plotly_bar_plotter(data = sd.pertype, height = 375, xlabel = "Tour Mode [Autos < HH Size]", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T, tickvals = seq(1,9), ticktext = tourMode, index = 2, bottom_offset = 55, tickangle = 300)
p3 <- plotly_bar_plotter(data = sd.pertype, height = 375, xlabel = "Tour Mode [Autos >= HH Size]", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T, tickvals = seq(1,9), ticktext = tourMode, index = 3, bottom_offset = 55, tickangle = 300)
p4 <- plotly_bar_plotter(data = sd.pertype, height = 375, xlabel = "Tour Mode [Total]", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T, tickvals = seq(1,9), ticktext = tourMode, index = 4, bottom_offset = 55, tickangle = 300)

filter_select("tourMode", "Select Tour Purpose", sd.pertype, ~grp_var,multiple=F)

```

********


**Tour Mode Choice**

Results of Tour Mode Choice Models, which selects a primary mode for each tour. 

Distribution of tours by tour mode and the ratio of autos to drivers in the household.


Chart Column 2 {data-width=400}
--------------------------------------------

### 
```{r tourMode2}
bscols(widths=c(12),
  list(p1,p2)
  )
```

Chart Column 3 {data-width=400}
--------------------------------------------

### 
```{r tourMode3}
bscols(widths=c(12),
  list(p3,p4)
  )
```


Stop Frequency {data-navmenu="Trip Level"}
============================================

Description {.sidebar data-width=175}
--------------------------------------------

********

**Stop Frequency**

Results of the Intermediate Stop Frequency Model, which predicts the number of intermediate stops on each tour by tour direction (outbound versus inbound).

The summary shows percent of tours by number of stops on the tour and tour direction.

**Stop Purpose**

Results of the Intermediate Stop Purpose Model, which is currently implemented as a Monte Carlo choice according to probability distributions generated from survey data.

The summary shows the percent of intermediate stops by stop purpose and tour purpose.

Chart Column 1 {data-width=200}
--------------------------------------------
### Stop Frequency - Directional
```{r stopfreq_dir}
base_df <- base_data[[which(base_csv_names=="stopfreqDir_vis")]]
build_df <- build_data[[which(build_csv_names=="stopfreqDir_vis")]]
colnames(build_df) <- colnames(base_df)

# change purpose names to standard format
base_df$purpose <- as.character(base_df$purpose)
build_df$purpose <- as.character(build_df$purpose)
base_df$purpose <- purpose_type_df$name[match(base_df$purpose, purpose_type_df$code)]
build_df$purpose <- purpose_type_df$name[match(build_df$purpose, purpose_type_df$code)]


sd.pertype1 <- get_standardDF(data_df1=base_df, data_df2=build_df, x="nstops", y = c("freq_out", "freq_inb"), grp = "purpose", shared = T)
p1 <- plotly_bar_plotter(data = sd.pertype1, height = 325, xlabel = "Number of Stops - Outbound", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T, tickvals = seq(1,4), ticktext = c("0", "1", "2", "3pl"))
p2 <- plotly_bar_plotter(data = sd.pertype1, height = 325, xlabel = "Number of Stops - Inbound", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T, tickvals = seq(1,4), ticktext = c("0", "1", "2", "3pl"), index = 2)
bscols(widths=c(12),
  list(
    filter_select("stopfreq_dir", "Select Tour Purpose", sd.pertype1, ~grp_var,multiple=F), 
    p1, 
    p2)
  )

```



Chart Column 1 {data-width=300}
--------------------------------------------
### Stop Frequency - Total{data-height=250}
```{r stopfreq_total}
base_df <- base_data[[which(base_csv_names=="stopfreq_total_vis")]]
build_df <- build_data[[which(build_csv_names=="stopfreq_total_vis")]]
colnames(build_df) <- colnames(base_df)

# change purpose names to standard format
base_df$purpose <- as.character(base_df$purpose)
build_df$purpose <- as.character(build_df$purpose)
base_df$purpose <- purpose_type_df$name[match(base_df$purpose, purpose_type_df$code)]
build_df$purpose <- purpose_type_df$name[match(build_df$purpose, purpose_type_df$code)]


sd.pertype2 <- get_standardDF(data_df1=base_df, data_df2=build_df, x="nstops", y = c("freq"), grp = "purpose", shared = T)
p1 <- plotly_bar_plotter(data = sd.pertype2, height = 350, xlabel = "Number of Stops", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T, tickvals = seq(1,6), ticktext = c("0", "1", "2", "4", "5", "6pl"))

bscols(widths=c(3,9),
  list(
    filter_select("stopfreq_total", "Select Tour Purpose", sd.pertype2, ~grp_var,multiple=F)),
    p1
  )
```

### Stop Purpose by Tour Purpose{data-height=250}
```{r stoppurp_tourpurp}
base_df <- base_data[[which(base_csv_names=="stoppurpose_tourpurpose_vis")]]
build_df <- build_data[[which(build_csv_names=="stoppurpose_tourpurpose_vis")]]
colnames(build_df) <- colnames(base_df)

# change purpose names to standard format
base_df$purpose <- as.character(base_df$purpose)
build_df$purpose <- as.character(build_df$purpose)
base_df$purpose <- purpose_type_df$name[match(base_df$purpose, purpose_type_df$code)]
build_df$purpose <- purpose_type_df$name[match(build_df$purpose, purpose_type_df$code)]


sd.pertype3 <- get_standardDF(data_df1=base_df, data_df2=build_df, x="stop_purp", y = c("freq"), grp = "purpose", shared = T)
p1 <- plotly_bar_plotter(data = sd.pertype3, height = 350, xlabel = "Stop Purpose", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T, tickvals = seq(1,10), ticktext = stopPurposes)

bscols(widths=c(3,9),
  list(
    filter_select("stoppurp_tourpurp", "Select Tour Purpose", sd.pertype3, ~grp_var,multiple=F)),
    p1
  )

```


Location{data-navmenu="Trip Level"}
============================================

Description {.sidebar data-width=175}
--------------------------------------------

********

**Stop Location**

Results of the Intermediate Stop Location Choice Model, which predicts the location of each intermediate stop.

The summary shows the distribution of intermediate stops by out of direction distance and tour purpose.

Out of direction distance is defined as the extra distance to the destination as a result of traveling through the stop location. 
For stops in the outbound direction, it is based on the distance between the last known location (the tour origin or previous outbound stop) and the tour primary destination.
For stops in the inbound direction, it is based on the distance between the last known location (the tour primary destination or previous inbound stop) and the tour origin.

Chart Column 1 {data-width=800}
--------------------------------------------

### Stop Location - Out of Direction Distance{data-height=350}
```{r stopDC}
base_df <- base_data[[which(base_csv_names=="stopDC_vis")]]
build_df <- build_data[[which(build_csv_names=="stopDC_vis")]]
colnames(build_df) <- colnames(base_df)

# change purpose names to standard format
base_df$PURPOSE <- as.character(base_df$PURPOSE)
build_df$PURPOSE <- as.character(build_df$PURPOSE)
base_df$PURPOSE <- purpose_type_df$name[match(base_df$PURPOSE, purpose_type_df$code)]
build_df$PURPOSE <- purpose_type_df$name[match(build_df$PURPOSE, purpose_type_df$code)]


sd.purpose <- get_sharedData(data_df1 = base_df, data_df2 = build_df, run1_name = BASE_SCENARIO_NAME, 
                             run2_name = BUILD_SCENARIO_NAME, x = "distbin", y = c("freq"), grp = "PURPOSE")

p1 <- plotly_density_plotter(sd.purpose, index = "one", xlabel = "Out of Direction Distance (Miles)", percent = T, left_offset = 25, 
                             tickvals = seq(1,42), ticktext = outDirDist, height = 600, tickangle = 300, bottom_offset = 50)
bscols(widths=c(12),
  list(
    filter_select("stopDC", "Select Tour Purpose", sd.purpose, ~grp_var,multiple=F), p1)
  )
```

Chart Column 1 {data-width=300}
--------------------------------------------

### Average Out of Direction Distance (Miles){data-height=250}
```{r Table1_outOfDir}
base_df <- base_data[[which(base_csv_names=="avgStopOutofDirectionDist_vis")]]
build_df <- build_data[[which(build_csv_names=="avgStopOutofDirectionDist_vis")]]
df <- data.frame(base_df, build_df[,-1])
colnames(df) <- c("Tour_Purpose", BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME)
df$Tour_Purpose <- purpose_type_df$name[match(df$Tour_Purpose, purpose_type_df$code)]
#
#t1 <- kable(df, format = "html", digits = 2, row.names = F, align = 'c', format.args = list(big.mark = ',')) %>%
#  kable_styling("striped", full_width = F)

t1 <- htmlTable(txtRound(df, 2), 
                align = "c|r",
                rnames = F,
                col.columns = c(rep("#E6E6F0", 1),
                          rep("none", ncol(df) - 1)), 
                caption = "_______________________________________________________")

t1
```


TOD{data-navmenu="Trip Level"}
============================================

Description {.sidebar data-width=175}
--------------------------------------------

********

**Stop Departure**

Results of the Stop Departure Time Choice Model. The departure time of each stop on the tour is currently implemented as a Monte Carlo choice of time period from distributions generated from survey data.

The entire day is divided into 40 half-hour bins (The first bin includes 3:00 AM to 5:00 AM and the last bin includes 12:00 PM to 3:00 AM).

**Trip Departure**

Summarizes all trips by departure time period, including trips to and from intermediate stops and the tour primary destination.

Chart Column 1 {.tabset}
--------------------------------------------

### Stop & Trip Departure{data-height=650}
```{r stopDep}
base_df <- base_data[[which(base_csv_names=="stopTripDep_vis")]]
build_df <- build_data[[which(build_csv_names=="stopTripDep_vis")]]
colnames(base_df) <- c("timebin", "purpose", "freq_stop", "freq_trip")
colnames(build_df) <- colnames(base_df)

# change purpose names to standard format
base_df$purpose <- as.character(base_df$purpose)
build_df$purpose <- as.character(build_df$purpose)
base_df$purpose <- purpose_type_df$name[match(base_df$purpose, purpose_type_df$code)]
build_df$purpose <- purpose_type_df$name[match(build_df$purpose, purpose_type_df$code)]


sd.purpose <- get_sharedData(data_df1 = base_df, data_df2 = build_df, run1_name = BASE_SCENARIO_NAME, 
                             run2_name = BUILD_SCENARIO_NAME, x = "timebin", y = c("freq_stop", "freq_trip"), grp = "purpose")

p1 <- plotly_density_plotter(sd.purpose, index = "one", xlabel = "Stop Departure", percent = T, left_offset = 25,
                             tickvals = seq(1,40), ticktext = todBins, bottom_offset = 150, tickangle = 315, height = 400)
p2 <- plotly_density_plotter(sd.purpose, index = "two", xlabel = "Trip Departure", percent = T, left_offset = 25, 
                             tickvals = seq(1,40), ticktext = todBins, bottom_offset = 150, tickangle = 315, height = 400)
p3 <- datatable(sd.purpose$data())
bscols(widths=c(2,10),
  filter_select("Tour Purpose", "Select Tour Purpose", sd.purpose, ~grp_var,multiple=F),
  list(p1, p2, p3)
  )
```

### Aggregate Stop & Trip Departure
```{r trip_tod_agg}
base_df <- base_data[[which(base_csv_names=="stopTripDep_vis")]]
colnames(base_df) <- c("id","purpose","freq_stop","freq_trip")
base_df$tod_agg <- cut(base_df$id, breaks = timePeriodBreaks, labels = timePeriods, right = FALSE)
base_df <- base_df %>%
  group_by(purpose, tod_agg) %>%
  summarise(freq_stop = sum(freq_stop), freq_trip = sum(freq_trip)) %>%
  ungroup()

build_df <- build_data[[which(build_csv_names=="stopTripDep_vis")]]
colnames(build_df) <- c("id","purpose","freq_stop","freq_trip")
build_df$tod_agg <- cut(build_df$id, breaks = timePeriodBreaks, labels = timePeriods, right = FALSE)
build_df <- build_df %>%
  group_by(purpose, tod_agg) %>%
  summarise(freq_stop = sum(freq_stop), freq_trip = sum(freq_trip)) %>%
  ungroup()
colnames(build_df) <- colnames(base_df)

# change purpose names to standard format
base_df$purpose <- as.character(base_df$purpose)
build_df$purpose <- as.character(build_df$purpose)
base_df$purpose <- purpose_type_df$name[match(base_df$purpose, purpose_type_df$code)]
build_df$purpose <- purpose_type_df$name[match(build_df$purpose, purpose_type_df$code)]

sd.purpose <- get_standardDF(data_df1=base_df, data_df2=build_df, x="tod_agg", y = c("freq_stop", "freq_trip"), grp = "purpose", shared = T)

p1 <- plotly_bar_plotter(data = sd.purpose, height = 350, xlabel = "Stop Departure", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T)
p2 <- plotly_bar_plotter(data = sd.purpose, height = 350, xlabel = "Trip Departure", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T, index = 2)

bscols(widths=c(2,10),
  filter_select("Tour Purpose", "Select Tour Purpose", sd.purpose, ~grp_var,multiple=F),
  list(p1, p2)
  )


```



Trip Mode{data-navmenu="Trip Level"}
============================================



Chart Column 1 {data-width=125}
--------------------------------------------

###  {data-height=200}

***Trip Mode Choice***

The results of the Trip Mode Choice Model, which predicts the mode of each trip on the tour.

Distribution of trips by trip mode and tour mode, which constrains the availability of each trip mode and influences the utility of each available trip mode.

### Trip Mode Choice
```{r tripMode}
base_df <- base_data[[which(base_csv_names=="tripModeProfile_vis")]]
build_df <- build_data[[which(build_csv_names=="tripModeProfile_vis")]]
colnames(build_df) <- colnames(base_df)

# change purpose names to standard format
base_df$purpose <- as.character(base_df$purpose)
build_df$purpose <- as.character(build_df$purpose)
base_df$purpose <- purpose_type_df$name[match(base_df$purpose, purpose_type_df$code)]
build_df$purpose <- purpose_type_df$name[match(build_df$purpose, purpose_type_df$code)]


sd.purpose <- get_standardDF(data_df1=base_df, data_df2=build_df, x="tripmode", y = c("value"), grp = "grp_var", shared = T)

p <- plotly_bar_plotter(data = sd.purpose, height = 700, xlabel = "Trip Mode", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T, tickvals = seq(1,9), ticktext = tripMode, bottom_offset = 75)

bscols(widths=c(12),
  list(filter_select("tripMode1", "Select Tour Purpose", sd.purpose, ~purpose,multiple=F), 
       filter_select("tripMode1", "Select Tour Mode", sd.purpose, ~tourmode,multiple=F))
  )
```

Chart Column 2 {data-width=800}
--------------------------------------------
###
```{r tripMode2}
bscols(widths=c(12),
  list(p)
  )

```

Count vs Volume: All Day{data-navmenu="Assignment"}
============================================

Description {.sidebar data-width=175}
--------------------------------------------

********

**Link level count comparison**

Results of auto assignment.

Comparison of observed counts and assigned volumes on each link with a counted volume, by assignment time period.


Chart Column 2{.tabset}
--------------------------------------------

### Count vs Volume by Facility Type{data-height=575}
```{r count_vol1}
base_df <- base_data[[which(base_csv_names=="LinkVolumes")]]
build_df <- build_data[[which(build_csv_names=="LinkVolumes")]]

counts_df <- data.frame(base_df[,c("CountLoc_ID","FACTYPE", "day_vol")], build_df$day_vol)
counts_df$FACTYPE <- facility_df$type[match(counts_df$FACTYPE, facility_df$code)]
counts_df$FACTYPE <- factor(counts_df$FACTYPE, levels = facility_types)

colnames(counts_df) <- c("CountLocation", "FACTYPE", "x", "y")

#remove rows where both x and y are zeros
counts_df <- counts_df[!(counts_df$x==0 & counts_df$y==0),]

eq <- counts_df %>% group_by(FACTYPE) %>% do(V1 = lm_eqn(.))
y_pos <- c(13000, 14000, 15000, 16000, 17000, 18000, 19000)
eq$y_pos <- y_pos

p1 <- ggplot(counts_df, aes(x=x, y=y, color=FACTYPE)) + 
  geom_point(shape=1) + 
  geom_smooth(method=lm, formula = y ~ x - 1, se=FALSE) + 
  geom_abline(intercept = 0, slope = 1, linetype = 2) + 
  geom_text(data = eq, aes(x = 2500, y = y_pos,label=V1),  parse = TRUE) + 
  geom_text(x = 22500, y = 0,label = "- - - - : 45 Deg Line",  parse = TRUE, color = "black") + 
  labs(x="24 Hours Counts", y="24 Hours Volume")
p1 <- plotly_build(p1)
p1

p2 <- ggplot(counts_df, aes(x=x, y=y)) + 
  geom_point(shape=1, color = "#0072B2") + 
  geom_smooth(method=lm, formula = y ~ x - 1, se=FALSE, color = "#0072B2") + 
  geom_abline(intercept = 0, slope = 1, linetype = 2) + 
  geom_text(x = 2500, y = 17500,label = lm_eqn(counts_df),  parse = TRUE, color = "#0072B2", size = 6) + 
  geom_text(x = 22500, y = 0,label = "- - - - : 45 Deg Line",  parse = TRUE, color = "black") + 
  labs(x="24 Hours Counts", y="24 Hours Volume")
p2 <- plotly_build(p2)

# Gap summary
counts_df <- counts_df %>%
  mutate(diff = y - x) %>%
  mutate(pdiff = diff/x) %>%
  mutate(gapRange = ifelse(pdiff>=1, ">=100%", "NA")) %>%
  mutate(gapRange = ifelse((pdiff>=0.5) & (pdiff<1), "50%~100%", gapRange)) %>%
  mutate(gapRange = ifelse((pdiff>=0.3) & (pdiff<0.5), "30%~50%", gapRange)) %>%
  mutate(gapRange = ifelse((pdiff>=0.2) & (pdiff<0.3), "20%~30%", gapRange)) %>%
  mutate(gapRange = ifelse((pdiff>=0.1) & (pdiff<0.2), "10%~20%", gapRange)) %>%
  mutate(gapRange = ifelse((pdiff>=0) & (pdiff<0.1), "0%~10%", gapRange)) %>%
  mutate(gapRange = ifelse((pdiff>=-0.1) & (pdiff< 0), "-10%~0%", gapRange)) %>%
  mutate(gapRange = ifelse((pdiff>=-0.2) & (pdiff< -0.1), "-20%~-10%", gapRange)) %>%
  mutate(gapRange = ifelse((pdiff>=-0.3) & (pdiff< -0.2), "-30%~-20%", gapRange)) %>%
  mutate(gapRange = ifelse((pdiff>=-0.5) & (pdiff< -0.3), "-50%~-30%", gapRange)) %>%
  mutate(gapRange = ifelse((pdiff < -0.5), "<-50%", gapRange)) %>%
  mutate(gapRange1 = ifelse((pdiff>=-0.1) & (pdiff< 0.1), 1, 0)) %>%
  mutate(gapRange2 = ifelse((pdiff>=-0.2) & (pdiff< 0.2), 1, 0)) %>%
  mutate(gapRange3 = ifelse((pdiff>=-0.3) & (pdiff< 0.3), 1, 0))

gap_summary_df <- counts_df %>%
  mutate(FACTYPE = as.character(FACTYPE)) %>%
  mutate(FACTYPE = ifelse((FACTYPE == "Principal Arterial" | FACTYPE == "Minor Arterial"), "Arterial", FACTYPE)) %>%
  mutate(FACTYPE = ifelse((FACTYPE == "Major Collector" | FACTYPE == "Minor Collector" | FACTYPE == "Local Road"), "Collector", FACTYPE))

## First Summary
gap_summary <- xtabs(~gapRange+FACTYPE, gap_summary_df)
gap_summary[is.na(gap_summary)] <- 0
gap_summary <- addmargins(as.table(gap_summary))
gap_summary <- as.data.frame.matrix(gap_summary)
gap_summary$id <- row.names(gap_summary)
colnames(gap_summary) <- c("Arterial","Collector","Interstate","Ramp","Total", "GapRange")
gap_summary$GapRange[gap_summary$GapRange=="Sum"] <- "Total"
gap_summary$HOV_Toll <- 0
gap_summary <- gap_summary %>%
  select(GapRange, Interstate, Ramp, HOV_Toll, Arterial, Collector, Total)

#Order the rows
GapRange <- c(">=100%", "50%~100%", "30%~50%", "20%~30%", "10%~20%", "0%~10%", 
              "-10%~0%", "-20%~-10%", "-30%~-20%", "-50%~-30%", "<-50%", "Total")
temp <- data.frame(GapRange, stringsAsFactors = F)
gap_summary <- temp %>%
  left_join(gap_summary, by = c("GapRange" = "GapRange"))
gap_summary[is.na(gap_summary)] <- 0
#gap_summary <- gap_summary[match(gapOrder, gap_summary$GapRange),]

# Compute percentages
gap_summary$Interstate_p = paste(round(gap_summary$Interstate/gap_summary$Interstate[gap_summary$GapRange=="Total"]*100, 1), "%", sep = "")
gap_summary$Ramp_p = paste(round(gap_summary$Ramp/gap_summary$Ramp[gap_summary$GapRange=="Total"]*100, 1), "%", sep = "")
gap_summary$HOV_Toll_p = 0
gap_summary$Arterial_p = paste(round(gap_summary$Arterial/gap_summary$Arterial[gap_summary$GapRange=="Total"]*100, 1), "%", sep = "")
gap_summary$Collector_p = paste(round(gap_summary$Collector/gap_summary$Collector[gap_summary$GapRange=="Total"]*100, 1), "%", sep = "")
gap_summary$Total_p = paste(round(gap_summary$Total/gap_summary$Total[gap_summary$GapRange=="Total"]*100, 1), "%", sep = "")

## Second Summary
gap_summary2 <- gap_summary_df %>%
  group_by(FACTYPE) %>%
  summarise(gapRange1=sum(gapRange1), gapRange2=sum(gapRange2), gapRange3=sum(gapRange3))
gap_summary2 <- as.data.frame(t(gap_summary2))[-1, ]
gap_summary2$V1 <- as.numeric(as.character(gap_summary2$V1))
gap_summary2$V2 <- as.numeric(as.character(gap_summary2$V2))
gap_summary2$V3 <- as.numeric(as.character(gap_summary2$V3))
gap_summary2$V4 <- as.numeric(as.character(gap_summary2$V4))
colnames(gap_summary2) <- c("Arterial", "Collector", "Interstate", "Ramp")
gapRanges <- c("-10%~10%", "-20%~20%", "-30%~30%")
gap_summary2$GapRange <- gapRanges
gap_summary2$Total <- gap_summary2$Arterial+gap_summary2$Collector+gap_summary2$Interstate+gap_summary2$Ramp
gap_summary2$HOV_Toll <- 0
gap_summary2 <- gap_summary2 %>%
  select(GapRange, Interstate, Ramp, HOV_Toll, Arterial, Collector, Total)

# compute percentages
gap_summary2 <- rbind(gap_summary2, gap_summary[gap_summary$GapRange=="Total", 1:7])
gap_summary2$Interstate_p = paste(round(gap_summary2$Interstate/gap_summary2$Interstate[gap_summary2$GapRange=="Total"]*100, 1), "%", sep = "")
gap_summary2$Ramp_p = paste(round(gap_summary2$Ramp/gap_summary2$Ramp[gap_summary2$GapRange=="Total"]*100, 1), "%", sep = "")
gap_summary2$HOV_Toll_p = 0
gap_summary2$Arterial_p = paste(round(gap_summary2$Arterial/gap_summary2$Arterial[gap_summary2$GapRange=="Total"]*100, 1), "%", sep = "")
gap_summary2$Collector_p = paste(round(gap_summary2$Collector/gap_summary2$Collector[gap_summary2$GapRange=="Total"]*100, 1), "%", sep = "")
gap_summary2$Total_p = paste(round(gap_summary2$Total/gap_summary2$Total[gap_summary2$GapRange=="Total"]*100, 1), "%", sep = "")
gap_summary2 <- gap_summary2[1:3, ]

## Third SUmmary (Average Gaps)
#gap_summary3 <- gap_summary2
#gap_summary3$GapRange <- c("Average (+) Gaps", "Average (-) Gaps", "Average of all")
#row1 <- gap_summary_df

```

### Count vs Volume - All Links{data-height=575}
```{r count_vol2}
p2
```

### Gap Statistics{data-height=575}
```{r count_vol3}
summary <- rbind(gap_summary, gap_summary2)
colnames(summary) <- c("GapRange", "Interstate", "Ramp", "HOV_Toll", "Arterial", "Collector", "Total", 
                       "Interstate", "Ramp", "HOV_Toll", "Arterial", "Collector", "Total")

#t1 <- kable(summary, format = 'html', digits = 2, row.names = F, align = 'r', format.args = list(big.mark = ',')) %>%
#  kable_styling('striped') %>%
#  add_header_above(c(' ' = 1, 'Number of Links' = 6, 'Percent of Links' = 6))


## length of the caption determines the width of teh table
t1 <- htmlTable(summary, 
                align = "c|cccccc|c",
                rnames = F,
                cgroup = c(" ", "Number of Links", "Percent of Links"),
                n.cgroup = c(1, 6,6),
                col.rgroup = c(rep("none", 3), rep("darkseagreen1", 6), rep("none", 2), "darkgoldenrod1", rep("darkseagreen", 3)),
                caption = "________________________________________________________________________________________________________________________________________________________________")


t1


```


Count vs Volume: AM{data-navmenu="Assignment"}
============================================

Description {.sidebar data-width=175}
--------------------------------------------

********

**Link level count comparison**

Results of auto assignment.

Comparison of observed counts and assigned volumes on each link with a counted volume, by assignment time period.


Chart Column 2{.tabset}
--------------------------------------------

### Count vs Volume by Facility Type{data-height=575}
```{r count_vol4}
base_df <- base_data[[which(base_csv_names=="LinkVolumes")]]
build_df <- build_data[[which(build_csv_names=="LinkVolumes")]]

counts_df <- data.frame(base_df[,c("CountLoc_ID","FACTYPE", "am_vol")], build_df$am_vol)
counts_df$FACTYPE <- facility_df$type[match(counts_df$FACTYPE, facility_df$code)]
counts_df$FACTYPE <- factor(counts_df$FACTYPE, levels = facility_types)

colnames(counts_df) <- c("CountLocation", "FACTYPE", "x", "y")

#remove rows where both x and y are zeros
counts_df <- counts_df[!(counts_df$x==0 & counts_df$y==0),]

eq <- counts_df %>% group_by(FACTYPE) %>% do(V1 = lm_eqn(.))
y_pos <- c(1500, 1650, 1800, 1950, 2100, 2250, 2400)
eq$y_pos <- y_pos

p1 <- ggplot(counts_df, aes(x=x, y=y, color=FACTYPE)) + 
  geom_point(shape=1) + 
  geom_smooth(method=lm, formula = y ~ x - 1, se=FALSE) + 
  geom_abline(intercept = 0, slope = 1, linetype = 2) + 
  geom_text(data = eq, aes(x = 50, y = y_pos,label=V1),  parse = TRUE) + 
  geom_text(x = 1500, y = 0,label = "- - - - : 45 Deg Line",  parse = TRUE, color = "black") + 
  labs(x="24 Hours Counts", y="24 Hours Volume")
p1 <- plotly_build(p1)
p1

p2 <- ggplot(counts_df, aes(x=x, y=y)) + 
  geom_point(shape=1, color = "#0072B2") + 
  geom_smooth(method=lm, formula = y ~ x - 1, se=FALSE, color = "#0072B2") + 
  geom_abline(intercept = 0, slope = 1, linetype = 2) + 
  geom_text(x = 250, y = 2200,label = lm_eqn(counts_df),  parse = TRUE, color = "#0072B2", size = 6) + 
  geom_text(x = 1500, y = 0,label = "- - - - : 45 Deg Line",  parse = TRUE, color = "black") + 
  labs(x="24 Hours Counts", y="24 Hours Volume")
p2 <- plotly_build(p2)

# Gap summary
counts_df <- counts_df %>%
  mutate(diff = y - x) %>%
  mutate(pdiff = diff/x) %>%
  mutate(gapRange = ifelse(pdiff>=1, ">=100%", "NA")) %>%
  mutate(gapRange = ifelse((pdiff>=0.5) & (pdiff<1), "50%~100%", gapRange)) %>%
  mutate(gapRange = ifelse((pdiff>=0.3) & (pdiff<0.5), "30%~50%", gapRange)) %>%
  mutate(gapRange = ifelse((pdiff>=0.2) & (pdiff<0.3), "20%~30%", gapRange)) %>%
  mutate(gapRange = ifelse((pdiff>=0.1) & (pdiff<0.2), "10%~20%", gapRange)) %>%
  mutate(gapRange = ifelse((pdiff>=0) & (pdiff<0.1), "0%~10%", gapRange)) %>%
  mutate(gapRange = ifelse((pdiff>=-0.1) & (pdiff< 0), "-10%~0%", gapRange)) %>%
  mutate(gapRange = ifelse((pdiff>=-0.2) & (pdiff< -0.1), "-20%~-10%", gapRange)) %>%
  mutate(gapRange = ifelse((pdiff>=-0.3) & (pdiff< -0.2), "-30%~-20%", gapRange)) %>%
  mutate(gapRange = ifelse((pdiff>=-0.5) & (pdiff< -0.3), "-50%~-30%", gapRange)) %>%
  mutate(gapRange = ifelse((pdiff < -0.5), "<-50%", gapRange)) %>%
  mutate(gapRange1 = ifelse((pdiff>=-0.1) & (pdiff< 0.1), 1, 0)) %>%
  mutate(gapRange2 = ifelse((pdiff>=-0.2) & (pdiff< 0.2), 1, 0)) %>%
  mutate(gapRange3 = ifelse((pdiff>=-0.3) & (pdiff< 0.3), 1, 0))

gap_summary_df <- counts_df %>%
  mutate(FACTYPE = as.character(FACTYPE)) %>%
  mutate(FACTYPE = ifelse((FACTYPE == "Principal Arterial" | FACTYPE == "Minor Arterial"), "Arterial", FACTYPE)) %>%
  mutate(FACTYPE = ifelse((FACTYPE == "Major Collector" | FACTYPE == "Minor Collector" | FACTYPE == "Local Road"), "Collector", FACTYPE))

## First Summary
gap_summary <- xtabs(~gapRange+FACTYPE, gap_summary_df)
gap_summary[is.na(gap_summary)] <- 0
gap_summary <- addmargins(as.table(gap_summary))
gap_summary <- as.data.frame.matrix(gap_summary)
gap_summary$id <- row.names(gap_summary)
colnames(gap_summary) <- c("Arterial","Collector","Interstate","Ramp","Total", "GapRange")
gap_summary$GapRange[gap_summary$GapRange=="Sum"] <- "Total"
gap_summary$HOV_Toll <- 0
gap_summary <- gap_summary %>%
  select(GapRange, Interstate, Ramp, HOV_Toll, Arterial, Collector, Total)

#Order the rows
GapRange <- c(">=100%", "50%~100%", "30%~50%", "20%~30%", "10%~20%", "0%~10%", 
              "-10%~0%", "-20%~-10%", "-30%~-20%", "-50%~-30%", "<-50%", "Total")
temp <- data.frame(GapRange, stringsAsFactors = F)
gap_summary <- temp %>%
  left_join(gap_summary, by = c("GapRange" = "GapRange"))
gap_summary[is.na(gap_summary)] <- 0
#gap_summary <- gap_summary[match(gapOrder, gap_summary$GapRange),]

# Compute percentages
gap_summary$Interstate_p = paste(round(gap_summary$Interstate/gap_summary$Interstate[gap_summary$GapRange=="Total"]*100, 1), "%", sep = "")
gap_summary$Ramp_p = paste(round(gap_summary$Ramp/gap_summary$Ramp[gap_summary$GapRange=="Total"]*100, 1), "%", sep = "")
gap_summary$HOV_Toll_p = 0
gap_summary$Arterial_p = paste(round(gap_summary$Arterial/gap_summary$Arterial[gap_summary$GapRange=="Total"]*100, 1), "%", sep = "")
gap_summary$Collector_p = paste(round(gap_summary$Collector/gap_summary$Collector[gap_summary$GapRange=="Total"]*100, 1), "%", sep = "")
gap_summary$Total_p = paste(round(gap_summary$Total/gap_summary$Total[gap_summary$GapRange=="Total"]*100, 1), "%", sep = "")

## Second Summary
gap_summary2 <- gap_summary_df %>%
  group_by(FACTYPE) %>%
  summarise(gapRange1=sum(gapRange1), gapRange2=sum(gapRange2), gapRange3=sum(gapRange3))
gap_summary2 <- as.data.frame(t(gap_summary2))[-1, ]
gap_summary2$V1 <- as.numeric(as.character(gap_summary2$V1))
gap_summary2$V2 <- as.numeric(as.character(gap_summary2$V2))
gap_summary2$V3 <- as.numeric(as.character(gap_summary2$V3))
gap_summary2$V4 <- as.numeric(as.character(gap_summary2$V4))
colnames(gap_summary2) <- c("Arterial", "Collector", "Interstate", "Ramp")
gapRanges <- c("-10%~10%", "-20%~20%", "-30%~30%")
gap_summary2$GapRange <- gapRanges
gap_summary2$Total <- gap_summary2$Arterial+gap_summary2$Collector+gap_summary2$Interstate+gap_summary2$Ramp
gap_summary2$HOV_Toll <- 0
gap_summary2 <- gap_summary2 %>%
  select(GapRange, Interstate, Ramp, HOV_Toll, Arterial, Collector, Total)

# compute percentages
gap_summary2 <- rbind(gap_summary2, gap_summary[gap_summary$GapRange=="Total", 1:7])
gap_summary2$Interstate_p = paste(round(gap_summary2$Interstate/gap_summary2$Interstate[gap_summary2$GapRange=="Total"]*100, 1), "%", sep = "")
gap_summary2$Ramp_p = paste(round(gap_summary2$Ramp/gap_summary2$Ramp[gap_summary2$GapRange=="Total"]*100, 1), "%", sep = "")
gap_summary2$HOV_Toll_p = 0
gap_summary2$Arterial_p = paste(round(gap_summary2$Arterial/gap_summary2$Arterial[gap_summary2$GapRange=="Total"]*100, 1), "%", sep = "")
gap_summary2$Collector_p = paste(round(gap_summary2$Collector/gap_summary2$Collector[gap_summary2$GapRange=="Total"]*100, 1), "%", sep = "")
gap_summary2$Total_p = paste(round(gap_summary2$Total/gap_summary2$Total[gap_summary2$GapRange=="Total"]*100, 1), "%", sep = "")
gap_summary2 <- gap_summary2[1:3, ]

## Third SUmmary (Average Gaps)
#gap_summary3 <- gap_summary2
#gap_summary3$GapRange <- c("Average (+) Gaps", "Average (-) Gaps", "Average of all")
#row1 <- gap_summary_df

```

### Count vs Volume - All Links{data-height=575}
```{r count_vol5}
p2
```

### Gap Statistics{data-height=575}
```{r count_vol6}
summary <- rbind(gap_summary, gap_summary2)
colnames(summary) <- c("GapRange", "Interstate", "Ramp", "HOV_Toll", "Arterial", "Collector", "Total", 
                       "Interstate", "Ramp", "HOV_Toll", "Arterial", "Collector", "Total")

#t1 <- kable(summary, format = 'html', digits = 2, row.names = F, align = 'r', format.args = list(big.mark = ',')) %>%
#  kable_styling('striped') %>%
#  add_header_above(c(' ' = 1, 'Number of Links' = 6, 'Percent of Links' = 6))


## length of the caption determines the width of teh table
t1 <- htmlTable(summary, 
                align = "c|cccccc|c",
                rnames = F,
                cgroup = c(" ", "Number of Links", "Percent of Links"),
                n.cgroup = c(1, 6,6),
                col.rgroup = c(rep("none", 3), rep("darkseagreen1", 6), rep("none", 2), "darkgoldenrod1", rep("darkseagreen", 3)),
                caption = "________________________________________________________________________________________________________________________________________________________________")


t1


```


Count vs Volume: MD{data-navmenu="Assignment"}
============================================

Description {.sidebar data-width=175}
--------------------------------------------

********

**Link level count comparison**

Results of auto assignment.

Comparison of observed counts and assigned volumes on each link with a counted volume, by assignment time period.


Chart Column 2{.tabset}
--------------------------------------------

### Count vs Volume by Facility Type{data-height=575}
```{r count_vol7}
base_df <- base_data[[which(base_csv_names=="LinkVolumes")]]
build_df <- build_data[[which(build_csv_names=="LinkVolumes")]]

counts_df <- data.frame(base_df[,c("CountLoc_ID","FACTYPE", "md_vol")], build_df$md_vol)
counts_df$FACTYPE <- facility_df$type[match(counts_df$FACTYPE, facility_df$code)]
counts_df$FACTYPE <- factor(counts_df$FACTYPE, levels = facility_types)

colnames(counts_df) <- c("CountLocation", "FACTYPE", "x", "y")

#remove rows where both x and y are zeros
counts_df <- counts_df[!(counts_df$x==0 & counts_df$y==0),]

eq <- counts_df %>% group_by(FACTYPE) %>% do(V1 = lm_eqn(.))
y_pos <- c(5000, 5500, 6000, 6500, 7000, 7500, 8000)
eq$y_pos <- y_pos

p1 <- ggplot(counts_df, aes(x=x, y=y, color=FACTYPE)) + 
  geom_point(shape=1) + 
  geom_smooth(method=lm, formula = y ~ x - 1, se=FALSE) + 
  geom_abline(intercept = 0, slope = 1, linetype = 2) + 
  geom_text(data = eq, aes(x = 1000, y = y_pos,label=V1),  parse = TRUE) + 
  geom_text(x = 10000, y = 0,label = "- - - - : 45 Deg Line",  parse = TRUE, color = "black") + 
  labs(x="24 Hours Counts", y="24 Hours Volume")
p1 <- plotly_build(p1)
p1

p2 <- ggplot(counts_df, aes(x=x, y=y)) + 
  geom_point(shape=1, color = "#0072B2") + 
  geom_smooth(method=lm, formula = y ~ x - 1, se=FALSE, color = "#0072B2") + 
  geom_abline(intercept = 0, slope = 1, linetype = 2) + 
  geom_text(x = 1000, y = 6000,label = lm_eqn(counts_df),  parse = TRUE, color = "#0072B2", size = 6) + 
  geom_text(x = 10000, y = 0,label = "- - - - : 45 Deg Line",  parse = TRUE, color = "black") + 
  labs(x="24 Hours Counts", y="24 Hours Volume")
p2 <- plotly_build(p2)

# Gap summary
counts_df <- counts_df %>%
  mutate(diff = y - x) %>%
  mutate(pdiff = diff/x) %>%
  mutate(gapRange = ifelse(pdiff>=1, ">=100%", "NA")) %>%
  mutate(gapRange = ifelse((pdiff>=0.5) & (pdiff<1), "50%~100%", gapRange)) %>%
  mutate(gapRange = ifelse((pdiff>=0.3) & (pdiff<0.5), "30%~50%", gapRange)) %>%
  mutate(gapRange = ifelse((pdiff>=0.2) & (pdiff<0.3), "20%~30%", gapRange)) %>%
  mutate(gapRange = ifelse((pdiff>=0.1) & (pdiff<0.2), "10%~20%", gapRange)) %>%
  mutate(gapRange = ifelse((pdiff>=0) & (pdiff<0.1), "0%~10%", gapRange)) %>%
  mutate(gapRange = ifelse((pdiff>=-0.1) & (pdiff< 0), "-10%~0%", gapRange)) %>%
  mutate(gapRange = ifelse((pdiff>=-0.2) & (pdiff< -0.1), "-20%~-10%", gapRange)) %>%
  mutate(gapRange = ifelse((pdiff>=-0.3) & (pdiff< -0.2), "-30%~-20%", gapRange)) %>%
  mutate(gapRange = ifelse((pdiff>=-0.5) & (pdiff< -0.3), "-50%~-30%", gapRange)) %>%
  mutate(gapRange = ifelse((pdiff < -0.5), "<-50%", gapRange)) %>%
  mutate(gapRange1 = ifelse((pdiff>=-0.1) & (pdiff< 0.1), 1, 0)) %>%
  mutate(gapRange2 = ifelse((pdiff>=-0.2) & (pdiff< 0.2), 1, 0)) %>%
  mutate(gapRange3 = ifelse((pdiff>=-0.3) & (pdiff< 0.3), 1, 0))

gap_summary_df <- counts_df %>%
  mutate(FACTYPE = as.character(FACTYPE)) %>%
  mutate(FACTYPE = ifelse((FACTYPE == "Principal Arterial" | FACTYPE == "Minor Arterial"), "Arterial", FACTYPE)) %>%
  mutate(FACTYPE = ifelse((FACTYPE == "Major Collector" | FACTYPE == "Minor Collector" | FACTYPE == "Local Road"), "Collector", FACTYPE))

## First Summary
gap_summary <- xtabs(~gapRange+FACTYPE, gap_summary_df)
gap_summary[is.na(gap_summary)] <- 0
gap_summary <- addmargins(as.table(gap_summary))
gap_summary <- as.data.frame.matrix(gap_summary)
gap_summary$id <- row.names(gap_summary)
colnames(gap_summary) <- c("Arterial","Collector","Interstate","Ramp","Total", "GapRange")
gap_summary$GapRange[gap_summary$GapRange=="Sum"] <- "Total"
gap_summary$HOV_Toll <- 0
gap_summary <- gap_summary %>%
  select(GapRange, Interstate, Ramp, HOV_Toll, Arterial, Collector, Total)

#Order the rows
GapRange <- c(">=100%", "50%~100%", "30%~50%", "20%~30%", "10%~20%", "0%~10%", 
              "-10%~0%", "-20%~-10%", "-30%~-20%", "-50%~-30%", "<-50%", "Total")
temp <- data.frame(GapRange, stringsAsFactors = F)
gap_summary <- temp %>%
  left_join(gap_summary, by = c("GapRange" = "GapRange"))
gap_summary[is.na(gap_summary)] <- 0
#gap_summary <- gap_summary[match(gapOrder, gap_summary$GapRange),]

# Compute percentages
gap_summary$Interstate_p = paste(round(gap_summary$Interstate/gap_summary$Interstate[gap_summary$GapRange=="Total"]*100, 1), "%", sep = "")
gap_summary$Ramp_p = paste(round(gap_summary$Ramp/gap_summary$Ramp[gap_summary$GapRange=="Total"]*100, 1), "%", sep = "")
gap_summary$HOV_Toll_p = 0
gap_summary$Arterial_p = paste(round(gap_summary$Arterial/gap_summary$Arterial[gap_summary$GapRange=="Total"]*100, 1), "%", sep = "")
gap_summary$Collector_p = paste(round(gap_summary$Collector/gap_summary$Collector[gap_summary$GapRange=="Total"]*100, 1), "%", sep = "")
gap_summary$Total_p = paste(round(gap_summary$Total/gap_summary$Total[gap_summary$GapRange=="Total"]*100, 1), "%", sep = "")

## Second Summary
gap_summary2 <- gap_summary_df %>%
  group_by(FACTYPE) %>%
  summarise(gapRange1=sum(gapRange1), gapRange2=sum(gapRange2), gapRange3=sum(gapRange3))
gap_summary2 <- as.data.frame(t(gap_summary2))[-1, ]
gap_summary2$V1 <- as.numeric(as.character(gap_summary2$V1))
gap_summary2$V2 <- as.numeric(as.character(gap_summary2$V2))
gap_summary2$V3 <- as.numeric(as.character(gap_summary2$V3))
gap_summary2$V4 <- as.numeric(as.character(gap_summary2$V4))
colnames(gap_summary2) <- c("Arterial", "Collector", "Interstate", "Ramp")
gapRanges <- c("-10%~10%", "-20%~20%", "-30%~30%")
gap_summary2$GapRange <- gapRanges
gap_summary2$Total <- gap_summary2$Arterial+gap_summary2$Collector+gap_summary2$Interstate+gap_summary2$Ramp
gap_summary2$HOV_Toll <- 0
gap_summary2 <- gap_summary2 %>%
  select(GapRange, Interstate, Ramp, HOV_Toll, Arterial, Collector, Total)

# compute percentages
gap_summary2 <- rbind(gap_summary2, gap_summary[gap_summary$GapRange=="Total", 1:7])
gap_summary2$Interstate_p = paste(round(gap_summary2$Interstate/gap_summary2$Interstate[gap_summary2$GapRange=="Total"]*100, 1), "%", sep = "")
gap_summary2$Ramp_p = paste(round(gap_summary2$Ramp/gap_summary2$Ramp[gap_summary2$GapRange=="Total"]*100, 1), "%", sep = "")
gap_summary2$HOV_Toll_p = 0
gap_summary2$Arterial_p = paste(round(gap_summary2$Arterial/gap_summary2$Arterial[gap_summary2$GapRange=="Total"]*100, 1), "%", sep = "")
gap_summary2$Collector_p = paste(round(gap_summary2$Collector/gap_summary2$Collector[gap_summary2$GapRange=="Total"]*100, 1), "%", sep = "")
gap_summary2$Total_p = paste(round(gap_summary2$Total/gap_summary2$Total[gap_summary2$GapRange=="Total"]*100, 1), "%", sep = "")
gap_summary2 <- gap_summary2[1:3, ]

## Third SUmmary (Average Gaps)
#gap_summary3 <- gap_summary2
#gap_summary3$GapRange <- c("Average (+) Gaps", "Average (-) Gaps", "Average of all")
#row1 <- gap_summary_df

```

### Count vs Volume - All Links{data-height=575}
```{r count_vol8}
p2
```

### Gap Statistics{data-height=575}
```{r count_vol9}
summary <- rbind(gap_summary, gap_summary2)
colnames(summary) <- c("GapRange", "Interstate", "Ramp", "HOV_Toll", "Arterial", "Collector", "Total", 
                       "Interstate", "Ramp", "HOV_Toll", "Arterial", "Collector", "Total")

#t1 <- kable(summary, format = 'html', digits = 2, row.names = F, align = 'r', format.args = list(big.mark = ',')) %>%
#  kable_styling('striped') %>%
#  add_header_above(c(' ' = 1, 'Number of Links' = 6, 'Percent of Links' = 6))


## length of the caption determines the width of teh table
t1 <- htmlTable(summary, 
                align = "c|cccccc|c",
                rnames = F,
                cgroup = c(" ", "Number of Links", "Percent of Links"),
                n.cgroup = c(1, 6,6),
                col.rgroup = c(rep("none", 3), rep("darkseagreen1", 6), rep("none", 2), "darkgoldenrod1", rep("darkseagreen", 3)),
                caption = "________________________________________________________________________________________________________________________________________________________________")


t1


```


Count vs Volume: PM{data-navmenu="Assignment"}
============================================

Description {.sidebar data-width=175}
--------------------------------------------

********

**Link level count comparison**

Results of auto assignment.

Comparison of observed counts and assigned volumes on each link with a counted volume, by assignment time period.


Chart Column 2{.tabset}
--------------------------------------------

### Count vs Volume by Facility Type{data-height=575}
```{r count_vol10}
base_df <- base_data[[which(base_csv_names=="LinkVolumes")]]
build_df <- build_data[[which(build_csv_names=="LinkVolumes")]]

counts_df <- data.frame(base_df[,c("CountLoc_ID","FACTYPE", "pm_vol")], build_df$pm_vol)
counts_df$FACTYPE <- facility_df$type[match(counts_df$FACTYPE, facility_df$code)]
counts_df$FACTYPE <- factor(counts_df$FACTYPE, levels = facility_types)

colnames(counts_df) <- c("CountLocation", "FACTYPE", "x", "y")

#remove rows where both x and y are zeros
counts_df <- counts_df[!(counts_df$x==0 & counts_df$y==0),]

eq <- counts_df %>% group_by(FACTYPE) %>% do(V1 = lm_eqn(.))
y_pos <- c(1500, 1650, 1800, 1950, 2100, 2250, 2400)
eq$y_pos <- y_pos

p1 <- ggplot(counts_df, aes(x=x, y=y, color=FACTYPE)) + 
  geom_point(shape=1) + 
  geom_smooth(method=lm, formula = y ~ x - 1, se=FALSE) + 
  geom_abline(intercept = 0, slope = 1, linetype = 2) + 
  geom_text(data = eq, aes(x = 250, y = y_pos,label=V1),  parse = TRUE) + 
  geom_text(x = 3000, y = 0,label = "- - - - : 45 Deg Line",  parse = TRUE, color = "black") + 
  labs(x="24 Hours Counts", y="24 Hours Volume")
p1 <- plotly_build(p1)
p1

p2 <- ggplot(counts_df, aes(x=x, y=y)) + 
  geom_point(shape=1, color = "#0072B2") + 
  geom_smooth(method=lm, formula = y ~ x - 1, se=FALSE, color = "#0072B2") + 
  geom_abline(intercept = 0, slope = 1, linetype = 2) + 
  geom_text(x = 500, y = 2000,label = lm_eqn(counts_df),  parse = TRUE, color = "#0072B2", size = 6) + 
  geom_text(x = 3000, y = 0,label = "- - - - : 45 Deg Line",  parse = TRUE, color = "black") + 
  labs(x="24 Hours Counts", y="24 Hours Volume")
p2 <- plotly_build(p2)

# Gap summary
counts_df <- counts_df %>%
  mutate(diff = y - x) %>%
  mutate(pdiff = diff/x) %>%
  mutate(gapRange = ifelse(pdiff>=1, ">=100%", "NA")) %>%
  mutate(gapRange = ifelse((pdiff>=0.5) & (pdiff<1), "50%~100%", gapRange)) %>%
  mutate(gapRange = ifelse((pdiff>=0.3) & (pdiff<0.5), "30%~50%", gapRange)) %>%
  mutate(gapRange = ifelse((pdiff>=0.2) & (pdiff<0.3), "20%~30%", gapRange)) %>%
  mutate(gapRange = ifelse((pdiff>=0.1) & (pdiff<0.2), "10%~20%", gapRange)) %>%
  mutate(gapRange = ifelse((pdiff>=0) & (pdiff<0.1), "0%~10%", gapRange)) %>%
  mutate(gapRange = ifelse((pdiff>=-0.1) & (pdiff< 0), "-10%~0%", gapRange)) %>%
  mutate(gapRange = ifelse((pdiff>=-0.2) & (pdiff< -0.1), "-20%~-10%", gapRange)) %>%
  mutate(gapRange = ifelse((pdiff>=-0.3) & (pdiff< -0.2), "-30%~-20%", gapRange)) %>%
  mutate(gapRange = ifelse((pdiff>=-0.5) & (pdiff< -0.3), "-50%~-30%", gapRange)) %>%
  mutate(gapRange = ifelse((pdiff < -0.5), "<-50%", gapRange)) %>%
  mutate(gapRange1 = ifelse((pdiff>=-0.1) & (pdiff< 0.1), 1, 0)) %>%
  mutate(gapRange2 = ifelse((pdiff>=-0.2) & (pdiff< 0.2), 1, 0)) %>%
  mutate(gapRange3 = ifelse((pdiff>=-0.3) & (pdiff< 0.3), 1, 0))

gap_summary_df <- counts_df %>%
  mutate(FACTYPE = as.character(FACTYPE)) %>%
  mutate(FACTYPE = ifelse((FACTYPE == "Principal Arterial" | FACTYPE == "Minor Arterial"), "Arterial", FACTYPE)) %>%
  mutate(FACTYPE = ifelse((FACTYPE == "Major Collector" | FACTYPE == "Minor Collector" | FACTYPE == "Local Road"), "Collector", FACTYPE))

## First Summary
gap_summary <- xtabs(~gapRange+FACTYPE, gap_summary_df)
gap_summary[is.na(gap_summary)] <- 0
gap_summary <- addmargins(as.table(gap_summary))
gap_summary <- as.data.frame.matrix(gap_summary)
gap_summary$id <- row.names(gap_summary)
colnames(gap_summary) <- c("Arterial","Collector","Interstate","Ramp","Total", "GapRange")
gap_summary$GapRange[gap_summary$GapRange=="Sum"] <- "Total"
gap_summary$HOV_Toll <- 0
gap_summary <- gap_summary %>%
  select(GapRange, Interstate, Ramp, HOV_Toll, Arterial, Collector, Total)

#Order the rows
GapRange <- c(">=100%", "50%~100%", "30%~50%", "20%~30%", "10%~20%", "0%~10%", 
              "-10%~0%", "-20%~-10%", "-30%~-20%", "-50%~-30%", "<-50%", "Total")
temp <- data.frame(GapRange, stringsAsFactors = F)
gap_summary <- temp %>%
  left_join(gap_summary, by = c("GapRange" = "GapRange"))
gap_summary[is.na(gap_summary)] <- 0
#gap_summary <- gap_summary[match(gapOrder, gap_summary$GapRange),]

# Compute percentages
gap_summary$Interstate_p = paste(round(gap_summary$Interstate/gap_summary$Interstate[gap_summary$GapRange=="Total"]*100, 1), "%", sep = "")
gap_summary$Ramp_p = paste(round(gap_summary$Ramp/gap_summary$Ramp[gap_summary$GapRange=="Total"]*100, 1), "%", sep = "")
gap_summary$HOV_Toll_p = 0
gap_summary$Arterial_p = paste(round(gap_summary$Arterial/gap_summary$Arterial[gap_summary$GapRange=="Total"]*100, 1), "%", sep = "")
gap_summary$Collector_p = paste(round(gap_summary$Collector/gap_summary$Collector[gap_summary$GapRange=="Total"]*100, 1), "%", sep = "")
gap_summary$Total_p = paste(round(gap_summary$Total/gap_summary$Total[gap_summary$GapRange=="Total"]*100, 1), "%", sep = "")

## Second Summary
gap_summary2 <- gap_summary_df %>%
  group_by(FACTYPE) %>%
  summarise(gapRange1=sum(gapRange1), gapRange2=sum(gapRange2), gapRange3=sum(gapRange3))
gap_summary2 <- as.data.frame(t(gap_summary2))[-1, ]
gap_summary2$V1 <- as.numeric(as.character(gap_summary2$V1))
gap_summary2$V2 <- as.numeric(as.character(gap_summary2$V2))
gap_summary2$V3 <- as.numeric(as.character(gap_summary2$V3))
gap_summary2$V4 <- as.numeric(as.character(gap_summary2$V4))
colnames(gap_summary2) <- c("Arterial", "Collector", "Interstate", "Ramp")
gapRanges <- c("-10%~10%", "-20%~20%", "-30%~30%")
gap_summary2$GapRange <- gapRanges
gap_summary2$Total <- gap_summary2$Arterial+gap_summary2$Collector+gap_summary2$Interstate+gap_summary2$Ramp
gap_summary2$HOV_Toll <- 0
gap_summary2 <- gap_summary2 %>%
  select(GapRange, Interstate, Ramp, HOV_Toll, Arterial, Collector, Total)

# compute percentages
gap_summary2 <- rbind(gap_summary2, gap_summary[gap_summary$GapRange=="Total", 1:7])
gap_summary2$Interstate_p = paste(round(gap_summary2$Interstate/gap_summary2$Interstate[gap_summary2$GapRange=="Total"]*100, 1), "%", sep = "")
gap_summary2$Ramp_p = paste(round(gap_summary2$Ramp/gap_summary2$Ramp[gap_summary2$GapRange=="Total"]*100, 1), "%", sep = "")
gap_summary2$HOV_Toll_p = 0
gap_summary2$Arterial_p = paste(round(gap_summary2$Arterial/gap_summary2$Arterial[gap_summary2$GapRange=="Total"]*100, 1), "%", sep = "")
gap_summary2$Collector_p = paste(round(gap_summary2$Collector/gap_summary2$Collector[gap_summary2$GapRange=="Total"]*100, 1), "%", sep = "")
gap_summary2$Total_p = paste(round(gap_summary2$Total/gap_summary2$Total[gap_summary2$GapRange=="Total"]*100, 1), "%", sep = "")
gap_summary2 <- gap_summary2[1:3, ]

## Third SUmmary (Average Gaps)
#gap_summary3 <- gap_summary2
#gap_summary3$GapRange <- c("Average (+) Gaps", "Average (-) Gaps", "Average of all")
#row1 <- gap_summary_df

```

### Count vs Volume - All Links{data-height=575}
```{r count_vol11}
p2
```

### Gap Statistics{data-height=575}
```{r count_vol12}
summary <- rbind(gap_summary, gap_summary2)
colnames(summary) <- c("GapRange", "Interstate", "Ramp", "HOV_Toll", "Arterial", "Collector", "Total", 
                       "Interstate", "Ramp", "HOV_Toll", "Arterial", "Collector", "Total")

#t1 <- kable(summary, format = 'html', digits = 2, row.names = F, align = 'r', format.args = list(big.mark = ',')) %>%
#  kable_styling('striped') %>%
#  add_header_above(c(' ' = 1, 'Number of Links' = 6, 'Percent of Links' = 6))


## length of the caption determines the width of teh table
t1 <- htmlTable(summary, 
                align = "c|cccccc|c",
                rnames = F,
                cgroup = c(" ", "Number of Links", "Percent of Links"),
                n.cgroup = c(1, 6,6),
                col.rgroup = c(rep("none", 3), rep("darkseagreen1", 6), rep("none", 2), "darkgoldenrod1", rep("darkseagreen", 3)),
                caption = "________________________________________________________________________________________________________________________________________________________________")


t1


```

VMT{data-navmenu="Assignment"}
============================================

Description {.sidebar data-width=225}
--------------------------------------------

**VMT by TSys Segment**

Total VMT for each segment by TOD



Chart Column 1
--------------------------------------------

### {data-height=280}
```{r Table1_VMT}
cat("Vehicle Miles Traveled")

base_df <- base_data[[which(base_csv_names=="vmtSummary")]]
df <- base_df
colnames(df) <- c("TOD", "SOV","HOV2","HOV3", "Truck", "Total")

eval_expr <- paste("t1 <- kable(df, format = 'html', digits = 0, row.names = F, align = 'r', format.args = list(big.mark = ',')) %>%
  kable_styling('striped', font_size = 12, full_width=F, position='center') %>%
  add_header_above(c(' ' = 1, '", BASE_SCENARIO_NAME, "' = 5))", sep = "")
eval(parse(text = eval_expr))
t1
```

Chart Column 1
--------------------------------------------

### {data-height=280}
```{r Table2_VMT}
cat("Vehicle Miles Traveled")

build_df <- build_data[[which(build_csv_names=="vmtSummary")]]
df <- build_df
colnames(df) <- c("TOD", "SOV","HOV2","HOV3", "Truck", "Total")

eval_expr <- paste("t1 <- kable(df, format = 'html', digits = 0, row.names = F, align = 'r', format.args = list(big.mark = ',')) %>%
  kable_styling('striped', font_size = 12, full_width=F, position='center') %>%
  add_header_above(c(' ' = 1, '", BUILD_SCENARIO_NAME, "' = 5))", sep = "")
eval(parse(text = eval_expr))
t1
```

CVM{data-navmenu="Aggregate"}
============================================

Description {.sidebar data-width=225}
--------------------------------------------

**CVM Trips**

Total trips by time of day and mode



Chart Column 1
--------------------------------------------

### {data-height=280}
```{r Table1_cvm}
cat("CVM Trips")

base_df <- base_data[[which(base_csv_names=="cvm_summary")]]
df <- base_df
colnames(df) <- c("TOD", "Car","Multi-Unit Truck","Single-Unit Truck", "Total")
df$TOD <- factor(df$TOD, levels = aggTimePeriods)
df <- df[order(df$TOD),]

eval_expr <- paste("t1 <- kable(df, format = 'html', digits = 0, row.names = F, align = 'c', format.args = list(big.mark = ',')) %>%
  kable_styling('striped', font_size = 12, full_width=F, position='center') %>%
  add_header_above(c(' ' = 1, '", BASE_SCENARIO_NAME, "' = 4))", sep = "")
eval(parse(text = eval_expr))
t1
```

Chart Column 1
--------------------------------------------

### {data-height=280}
```{r Table2_cvm}
cat("CVM Trips")

build_df <- build_data[[which(build_csv_names=="cvm_summary")]]
df <- build_df
colnames(df) <- c("TOD", "Car","Multi-Unit Truck","Single-Unit Truck", "Total")
df$TOD <- factor(df$TOD, levels = aggTimePeriods)
df <- df[order(df$TOD),]

eval_expr <- paste("t1 <- kable(df, format = 'html', digits = 0, row.names = F, align = 'c', format.args = list(big.mark = ',')) %>%
  kable_styling('striped', font_size = 12, full_width=F, position='center') %>%
  add_header_above(c(' ' = 1, '", BUILD_SCENARIO_NAME, "' = 4))", sep = "")
eval(parse(text = eval_expr))
t1
```

External{data-navmenu="Aggregate"}
============================================

Description {.sidebar data-width=225}
--------------------------------------------

**External Trips**

Total trips by time of day and purpose



Chart Column 1
--------------------------------------------

### {data-height=280}
```{r Table1_ext}
cat("External Trips")

base_df <- base_data[[which(base_csv_names=="ext_summary")]]
df <- base_df
colnames(df) <- c("TOD", "HBCOLL","HBO","HBR", "HBS", "HBSCH", "HBW", "NHBNW", "NHBW", "Truck", "Total")
df$TOD <- factor(df$TOD, levels = aggTimePeriods)
df <- df[order(df$TOD),]

eval_expr <- paste("t1 <- kable(df, format = 'html', digits = 0, row.names = F, align = 'c', format.args = list(big.mark = ',')) %>%
  kable_styling('striped', font_size = 12, full_width=F, position='center') %>%
  add_header_above(c(' ' = 1, '", BASE_SCENARIO_NAME, "' = 10))", sep = "")
eval(parse(text = eval_expr))
t1
```


### {data-height=280}
```{r Table2_ext}
cat("External Trips")

build_df <- build_data[[which(build_csv_names=="ext_summary")]]
df <- build_df
colnames(df) <- c("TOD", "HBCOLL","HBO","HBR", "HBS", "HBSCH", "HBW", "NHBNW", "NHBW", "Truck", "Total")
df$TOD <- factor(df$TOD, levels = aggTimePeriods)
df <- df[order(df$TOD),]

eval_expr <- paste("t1 <- kable(df, format = 'html', digits = 0, row.names = F, align = 'c', format.args = list(big.mark = ',')) %>%
  kable_styling('striped', font_size = 12, full_width=F, position='center') %>%
  add_header_above(c(' ' = 1, '", BUILD_SCENARIO_NAME, "' = 10))", sep = "")
eval(parse(text = eval_expr))
t1
```